pkg/fizhi/fizhi_write_pickup.F

a456aa407c Andr*0001 #include "FIZHI_OPTIONS.h"
e337e4ca8c Andr*0002 CBOP
9f24b0ff20 Jean*0003 C     !ROUTINE: FIZHI_WRITE_PICKUP
e337e4ca8c Andr*0004 C     !INTERFACE:
                0005       SUBROUTINE FIZHI_WRITE_PICKUP( suff, myTime, myIter, myThid )
                0006
                0007 C     !DESCRIPTION: \bv
                0008 C     *==========================================================*
                0009 C     | S/R FIZHI_WRITE_PICKUP
                0010 C     | o Writes current state of fizhi package to a pickup file
                0011 C     *==========================================================*
                0012 C     \ev
                0013
                0014 C     !USES:
                0015 CEOP
                0016       IMPLICIT NONE
                0017
                0018 C     == Global variables ===
                0019 #include "SIZE.h"
                0020 #include "fizhi_SIZE.h"
f4a0368053 Andr*0021 #include "fizhi_land_SIZE.h"
e337e4ca8c Andr*0022 #include "fizhi_coms.h"
f4a0368053 Andr*0023 #include "fizhi_land_coms.h"
e337e4ca8c Andr*0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     == Routine Arguments ==
                0029 C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
                0030 C     myTime  :: current time
                0031 C     myIter  :: time-step number
                0032 C     myThid  :: Number of this instance
                0033       CHARACTER*(*) suff
                0034       _RL myTime
                0035       INTEGER myIter
                0036       INTEGER myThid
                0037
                0038 C     !LOCAL VARIABLES:
                0039 C     fn      :: character buffer for creating filename
                0040 C     prec    :: precision of pickup files
                0041 C     lgf     :: flag to write "global" files
e3ab16c632 Andr*0042       INTEGER prec, iChara, lChar
e337e4ca8c Andr*0043       CHARACTER*(MAX_LEN_FNAM) fn
                0044       LOGICAL lgf
b710f4e61f Andr*0045       _RL temp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nrphys,Nsx,Nsy)
                0046       integer i,j,k,bi,bj
e337e4ca8c Andr*0047
                0048 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
133869fa0b Andr*0049       do bj = 1,myByLo(myThid), myByHi(myThid)
                0050       do bi = 1,myBxLo(myThid), myBxHi(myThid)
b710f4e61f Andr*0051       do k = 1,Nrphys
                0052       do j = 1-OLy,sNy+OLy
                0053       do i = 1-OLx,sNx+OLx
                0054        temp(i,j,k,bi,bj) = 0.
                0055       enddo
                0056       enddo
                0057       enddo
                0058       enddo
                0059       enddo
e337e4ca8c Andr*0060
                0061       lChar = 0
e3ab16c632 Andr*0062       DO iChara = 1,len(suff)
                0063        IF ( suff(iChara:iChara) .NE. ' ') lChar=iChara
e337e4ca8c Andr*0064       ENDDO
                0065       WRITE(fn,'(A,A)') 'pickup_fizhi.',suff(1:lChar)
                0066       prec = precFloat64
                0067       lgf = globalFiles
                0068
                0069 C--   Write fields as consecutive records
9f24b0ff20 Jean*0070       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,uphy,      1,myIter,myThid)
                0071       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,vphy,      2,myIter,myThid)
                0072       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,thphy,     3,myIter,myThid)
                0073       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,sphy,      4,myIter,myThid)
e337e4ca8c Andr*0074
9f24b0ff20 Jean*0075       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,cldtot_lw, 5,myIter,myThid)
                0076       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,cldras_lw, 6,myIter,myThid)
                0077       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,cldlsp_lw, 7,myIter,myThid)
                0078       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,lwlz,      8,myIter,myThid)
                0079       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,cldtot_sw, 9,myIter,myThid)
                0080       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,cldras_sw,10,myIter,myThid)
                0081       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,cldlsp_sw,11,myIter,myThid)
                0082       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,swlz,     12,myIter,myThid)
                0083       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,qliqavelw,13,myIter,myThid)
                0084       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,qliqavesw,14,myIter,myThid)
                0085       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,fccavelw, 15,myIter,myThid)
                0086       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,fccavesw, 16,myIter,myThid)
b710f4e61f Andr*0087
133869fa0b Andr*0088       do bj = myByLo(myThid), myByHi(myThid)
                0089       do bi = myBxLo(myThid), myBxHi(myThid)
20ef5cd2ad Andr*0090       do j = 1,sNy
                0091       do i = 1,sNx
e3ab16c632 Andr*0092        temp(i,j,1,bi,bj) = raincon(i,j,bi,bj)
                0093        temp(i,j,2,bi,bj) = rainlsp(i,j,bi,bj)
                0094        temp(i,j,3,bi,bj) = snowfall(i,j,bi,bj)
                0095       enddo
                0096       enddo
51d754cfa0 Andr*0097
                0098       temp(1,1,4,bi,bj) = float(iras(bi,bj))
                0099       temp(2,1,4,bi,bj) = float(nlwcld(bi,bj))
                0100       temp(3,1,4,bi,bj) = float(nlwlz(bi,bj))
                0101       temp(4,1,4,bi,bj) = float(nswcld(bi,bj))
                0102       temp(5,1,4,bi,bj) = float(nswlz(bi,bj))
                0103       temp(6,1,4,bi,bj) = float(imstturbsw(bi,bj))
                0104       temp(7,1,4,bi,bj) = float(imstturblw(bi,bj))
                0105
e3ab16c632 Andr*0106       enddo
                0107       enddo
                0108
9f24b0ff20 Jean*0109       CALL WRITE_REC_3D_RL(fn,prec,Nrphys,temp,17,myIter,myThid)
b710f4e61f Andr*0110
e337e4ca8c Andr*0111       RETURN
                0112       END