pkg/fizhi/fizhi_read_pickup.F

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