Back to home page

MITgcm
 
 

    

File indexing completed on 2023-07-14 05:10:28 UTC

view on githubraw file Latest commit de57a2ec on 2023-07-13 16:55:13 UTC
4ef02e4efb Ed H*0001 #include "FIZHI_OPTIONS.h"
a0355f4264 Ed H*0002 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4ef02e4efb Ed H*0003 CBOP
c424ee7cc7 Jean*0004 C     !ROUTINE: FIZHI_WRITE_VEGTILES
4ef02e4efb Ed H*0005 C     !INTERFACE:
700ccb58eb Andr*0006       SUBROUTINE FIZHI_WRITE_VEGTILES(fn,pickupflg,myTime,myIter,myThid)
4ef02e4efb Ed H*0007 
                0008 C     !DESCRIPTION:
                0009 
                0010 C     !USES:
                0011       IMPLICIT NONE
881cd8848f Andr*0012 #include "SIZE.h"
4ef02e4efb Ed H*0013 #include "fizhi_SIZE.h"
                0014 #include "fizhi_land_SIZE.h"
                0015 #include "fizhi_coms.h"
                0016 #include "fizhi_land_coms.h"
                0017 #include "fizhi_earth_coms.h"
                0018 #include "EEPARAMS.h"
a0355f4264 Ed H*0019 #include "PARAMS.h"
391fda017a Andr*0020 #ifdef ALLOW_MNC
                0021 #include "MNC_PARAMS.h"
                0022 #endif
75f4dd05c8 Andr*0023 #ifdef ALLOW_EXCH2
f9f661930b Jean*0024 #include "W2_EXCH2_SIZE.h"
75f4dd05c8 Andr*0025 #include "W2_EXCH2_TOPOLOGY.h"
                0026 #endif /* ALLOW_EXCH2 */
                0027 
4ef02e4efb Ed H*0028       EXTERNAL ILNBLNK
                0029       INTEGER ILNBLNK
660d83f1cd Andr*0030       INTEGER MDS_RECLEN
4ef02e4efb Ed H*0031 
                0032 C     !INPUT/OUTPUT PARAMETERS:
cc04975b16 Jean*0033       CHARACTER*(*) fn
700ccb58eb Andr*0034       INTEGER pickupflg
4ef02e4efb Ed H*0035       _RL myTime
                0036       INTEGER myIter
                0037       INTEGER myThid
                0038 
                0039 CEOP
                0040 C     !LOCAL VARIABLES:
700ccb58eb Andr*0041       CHARACTER*1 prec
4ef02e4efb Ed H*0042       CHARACTER*80 bnam
de57a2ec4b Mart*0043       character*(MAX_LEN_FNAM) dataFName
4ef02e4efb Ed H*0044       integer ilst
75f4dd05c8 Andr*0045       integer i,k,n
                0046       integer ig,jg,tn,iunit
                0047       integer length_of_rec
                0048       integer bi,bj,irec,fileprec
                0049       Real*8 r8seg(nchp)
4ef02e4efb Ed H*0050 
                0051 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0052 
881cd8848f Andr*0053       DO i = 1,80
4ef02e4efb Ed H*0054         bnam(i:i) = ' '
                0055       ENDDO
                0056       ilst = ILNBLNK(fn)
1279bcbdce Ed H*0057       if (pickupflg.eq.0) then
                0058         prec = 'D'
75f4dd05c8 Andr*0059         fileprec = 64
1279bcbdce Ed H*0060         WRITE(bnam,'(a,a)') 'pickup_vegtiles.', fn(1:ilst)
700ccb58eb Andr*0061       else
1279bcbdce Ed H*0062         prec = 'D'
75f4dd05c8 Andr*0063         fileprec = 64
1279bcbdce Ed H*0064         WRITE(bnam,'(a,a)') 'state_vegtiles.', fn(1:ilst)
700ccb58eb Andr*0065       endif
c424ee7cc7 Jean*0066 
4ef02e4efb Ed H*0067 #ifdef ALLOW_MNC
391fda017a Andr*0068       IF (useMNC.AND. pickup_write_mnc) THEN
4ef02e4efb Ed H*0069 
                0070 C       Write fizhi veg-space variables using the MNC package
                0071         CALL MNC_CW_SET_UDIM(bnam, 1, myThid)
987ff12cb6 Ed H*0072         CALL MNC_CW_RL_W_S('D',bnam,0,0,'T', myTime, myThid)
                0073         CALL MNC_CW_I_W_S('I',bnam,0,0,'iter',myIter,myThid)
4ef02e4efb Ed H*0074 
                0075 C       fizhi_coms.h
                0076         CALL MNC_CW_RL_W(prec,bnam,0,0,'ctmt', ctmt, myThid)
                0077         CALL MNC_CW_RL_W(prec,bnam,0,0,'xxmt', xxmt, myThid)
                0078         CALL MNC_CW_RL_W(prec,bnam,0,0,'yymt', yymt, myThid)
                0079         CALL MNC_CW_RL_W(prec,bnam,0,0,'zetamt', zetamt, myThid)
                0080         CALL MNC_CW_RL_W(prec,bnam,0,0,'xlmt', xlmt, myThid)
                0081         CALL MNC_CW_RL_W(prec,bnam,0,0,'khmt', khmt, myThid)
                0082         CALL MNC_CW_RL_W(prec,bnam,0,0,'tke', tke, myThid)
                0083 
                0084 C       fizhi_land_coms.h
                0085         CALL MNC_CW_RL_W(prec,bnam,0,0,'tcanopy', tcanopy, myThid)
                0086         CALL MNC_CW_RL_W(prec,bnam,0,0,'tdeep', tdeep, myThid)
                0087         CALL MNC_CW_RL_W(prec,bnam,0,0,'ecanopy', ecanopy, myThid)
                0088         CALL MNC_CW_RL_W(prec,bnam,0,0,'swetshal', swetshal, myThid)
                0089         CALL MNC_CW_RL_W(prec,bnam,0,0,'swetroot', swetroot, myThid)
                0090         CALL MNC_CW_RL_W(prec,bnam,0,0,'swetdeep', swetdeep, myThid)
                0091         CALL MNC_CW_RL_W(prec,bnam,0,0,'snodep', snodep, myThid)
                0092         CALL MNC_CW_RL_W(prec,bnam,0,0,'capac', capac, myThid)
                0093         CALL MNC_CW_RL_W(prec,bnam,0,0,'chlt', chlt, myThid)
                0094         CALL MNC_CW_RL_W(prec,bnam,0,0,'chlon', chlon, myThid)
1279bcbdce Ed H*0095         CALL MNC_CW_I_W('I',bnam,0,0,'igrd', igrd, myThid)
4ef02e4efb Ed H*0096 
                0097 C       fizhi_earth_coms.h
1279bcbdce Ed H*0098         CALL MNC_CW_I_W('I',bnam,0,0,'ityp', ityp, myThid)
4ef02e4efb Ed H*0099         CALL MNC_CW_RL_W(prec,bnam,0,0,'chfr', chfr, myThid)
                0100 
                0101       ENDIF
391fda017a Andr*0102 #endif /*  Not ALLOW_MNC sequence */
75f4dd05c8 Andr*0103 
a0355f4264 Ed H*0104 
75f4dd05c8 Andr*0105       call MDSFINDUNIT( iunit, mythid )
                0106       length_of_rec=MDS_RECLEN( fileprec, nchp, mythid )
                0107 
                0108       DO bj = myByLo(myThid), myByHi(myThid)
                0109       DO bi = myBxLo(myThid), myBxHi(myThid)
                0110 
                0111 #ifdef ALLOW_EXCH2
c424ee7cc7 Jean*0112        tn = W2_myTileList(bi,bj)
172027e04f Andr*0113        iG = tn
                0114        jG = 1
75f4dd05c8 Andr*0115 #else
                0116        iG = bi+(myXGlobalLo-1)/sNx
                0117        jG = bj+(myYGlobalLo-1)/sNy
                0118        tn = (jG - 1)*(nPx*nSx) + iG
                0119 #endif /* ALLOW_EXCH2 */
                0120 
de57a2ec4b Mart*0121        write(dataFname,'(a,2a,i3.3,a,i3.3,a)')
172027e04f Andr*0122      &  'pickup_vegtiles.',fn(1:ilst),'.',iG,'.',jG,'.data'
660d83f1cd Andr*0123        open( iUnit, file=dataFName, status='unknown',
75f4dd05c8 Andr*0124      &       access='direct', recl=length_of_rec )
                0125 
                0126 C First write single-level turbulence fields
                0127        do n = 1,nchp
                0128         r8seg(n) = ctmt(n,bi,bj)
                0129        enddo
                0130 #ifdef _BYTESWAPIO
                0131        call MDS_BYTESWAPR8( nchp, r8seg )
                0132 #endif
                0133        write(iunit,rec=1) r8seg
                0134 
                0135        do n = 1,nchp
                0136         r8seg(n) = xxmt(n,bi,bj)
                0137        enddo
                0138 #ifdef _BYTESWAPIO
                0139        call MDS_BYTESWAPR8( nchp, r8seg )
                0140 #endif
                0141        write(iunit,rec=2) r8seg
                0142 
                0143        do n = 1,nchp
                0144         r8seg(n) = yymt(n,bi,bj)
                0145        enddo
                0146 #ifdef _BYTESWAPIO
                0147        call MDS_BYTESWAPR8( nchp, r8seg )
                0148 #endif
                0149        write(iunit,rec=3) r8seg
                0150 
                0151        do n = 1,nchp
                0152         r8seg(n) = zetamt(n,bi,bj)
                0153        enddo
                0154 #ifdef _BYTESWAPIO
                0155        call MDS_BYTESWAPR8( nchp, r8seg )
                0156 #endif
                0157        write(iunit,rec=4) r8seg
                0158 
                0159 C And now write Multi-level turbulence fields
                0160        do k = 1,Nrphys
                0161         do n = 1,nchp
                0162          r8seg(n) = xlmt(n,k,bi,bj)
                0163         enddo
                0164 #ifdef _BYTESWAPIO
                0165         call MDS_BYTESWAPR8( nchp, r8seg )
                0166 #endif
                0167         irec = 4 + 0*Nrphys + k
                0168         write(iunit,rec=irec) r8seg
                0169        enddo
                0170 
                0171        do k = 1,Nrphys
                0172         do n = 1,nchp
                0173          r8seg(n) = khmt(n,k,bi,bj)
                0174         enddo
                0175 #ifdef _BYTESWAPIO
                0176         call MDS_BYTESWAPR8( nchp, r8seg )
                0177 #endif
                0178         irec = 4 + 1*Nrphys + k
                0179         write(iunit,rec=irec) r8seg
                0180        enddo
                0181 
                0182        do k = 1,Nrphys
                0183         do n = 1,nchp
                0184          r8seg(n) = tke(n,k,bi,bj)
                0185         enddo
                0186 #ifdef _BYTESWAPIO
                0187         call MDS_BYTESWAPR8( nchp, r8seg )
                0188 #endif
                0189         irec = 4 + 2*Nrphys + k
                0190         write(iunit,rec=irec) r8seg
                0191        enddo
                0192 
                0193 C And finally, write land surface fields
                0194        do n = 1,nchp
                0195         r8seg(n) = tcanopy(n,bi,bj)
                0196        enddo
                0197 #ifdef _BYTESWAPIO
                0198        call MDS_BYTESWAPR8( nchp, r8seg )
                0199 #endif
                0200        irec = 4 + 3*Nrphys + 1
                0201        write(iunit,rec=irec) r8seg
                0202 
                0203        do n = 1,nchp
                0204         r8seg(n) = tdeep(n,bi,bj)
                0205        enddo
                0206 #ifdef _BYTESWAPIO
                0207        call MDS_BYTESWAPR8( nchp, r8seg )
                0208 #endif
                0209        irec = 4 + 3*Nrphys + 2
                0210        write(iunit,rec=irec) r8seg
                0211 
                0212        do n = 1,nchp
                0213         r8seg(n) = ecanopy(n,bi,bj)
                0214        enddo
                0215 #ifdef _BYTESWAPIO
                0216        call MDS_BYTESWAPR8( nchp, r8seg )
                0217 #endif
                0218        irec = 4 + 3*Nrphys + 3
                0219        write(iunit,rec=irec) r8seg
                0220 
                0221        do n = 1,nchp
                0222         r8seg(n) = swetshal(n,bi,bj)
                0223        enddo
                0224 #ifdef _BYTESWAPIO
                0225        call MDS_BYTESWAPR8( nchp, r8seg )
                0226 #endif
                0227        irec = 4 + 3*Nrphys + 4
                0228        write(iunit,rec=irec) r8seg
                0229 
                0230        do n = 1,nchp
                0231         r8seg(n) = swetroot(n,bi,bj)
                0232        enddo
                0233 #ifdef _BYTESWAPIO
                0234        call MDS_BYTESWAPR8( nchp, r8seg )
                0235 #endif
                0236        irec = 4 + 3*Nrphys + 5
                0237        write(iunit,rec=irec) r8seg
                0238 
                0239        do n = 1,nchp
                0240         r8seg(n) = swetdeep(n,bi,bj)
                0241        enddo
                0242 #ifdef _BYTESWAPIO
                0243        call MDS_BYTESWAPR8( nchp, r8seg )
                0244 #endif
                0245        irec = 4 + 3*Nrphys + 6
                0246        write(iunit,rec=irec) r8seg
                0247 
                0248        do n = 1,nchp
                0249         r8seg(n) = snodep(n,bi,bj)
                0250        enddo
                0251 #ifdef _BYTESWAPIO
                0252        call MDS_BYTESWAPR8( nchp, r8seg )
                0253 #endif
                0254        irec = 4 + 3*Nrphys + 7
                0255        write(iunit,rec=irec) r8seg
                0256 
                0257        do n = 1,nchp
                0258         r8seg(n) = capac(n,bi,bj)
                0259        enddo
                0260 #ifdef _BYTESWAPIO
                0261        call MDS_BYTESWAPR8( nchp, r8seg )
                0262 #endif
                0263        irec = 4 + 3*Nrphys + 8
                0264        write(iunit,rec=irec) r8seg
                0265 
                0266        close(iunit)
                0267 
                0268 C End of bi bj loop
                0269       enddo
                0270       enddo
                0271 
4ef02e4efb Ed H*0272       RETURN
                0273       END
                0274 
                0275 
                0276 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0277 CBOP
                0278 C     !ROUTINE: FIZHI_READ_VEGTILES
                0279 C     !INTERFACE:
0d3b3f6504 Andr*0280       SUBROUTINE FIZHI_READ_VEGTILES(Iter,prec,myThid)
4ef02e4efb Ed H*0281 
                0282 C     !DESCRIPTION:
                0283 
                0284 C     !USES:
                0285       IMPLICIT NONE
881cd8848f Andr*0286 #include "SIZE.h"
4ef02e4efb Ed H*0287 #include "fizhi_SIZE.h"
                0288 #include "fizhi_land_SIZE.h"
                0289 #include "fizhi_coms.h"
                0290 #include "fizhi_land_coms.h"
                0291 #include "fizhi_earth_coms.h"
                0292 #include "EEPARAMS.h"
a0355f4264 Ed H*0293 #include "PARAMS.h"
391fda017a Andr*0294 #ifdef ALLOW_MNC
                0295 #include "MNC_PARAMS.h"
                0296 #endif
660d83f1cd Andr*0297 #ifdef ALLOW_EXCH2
f9f661930b Jean*0298 #include "W2_EXCH2_SIZE.h"
660d83f1cd Andr*0299 #include "W2_EXCH2_TOPOLOGY.h"
                0300 #endif /* ALLOW_EXCH2 */
                0301 
4ef02e4efb Ed H*0302       EXTERNAL ILNBLNK
                0303       INTEGER ILNBLNK
660d83f1cd Andr*0304       INTEGER MDS_RECLEN
4ef02e4efb Ed H*0305 
                0306 C     !INPUT/OUTPUT PARAMETERS:
                0307       CHARACTER*1 prec
0d3b3f6504 Andr*0308       INTEGER Iter
4ef02e4efb Ed H*0309       INTEGER myThid
                0310 
                0311 CEOP
                0312 C     !LOCAL VARIABLES:
72d95bfc5d Andr*0313       CHARACTER*80 fn
4ef02e4efb Ed H*0314       CHARACTER*80 bnam
                0315       integer ilst
de57a2ec4b Mart*0316       character*(MAX_LEN_FNAM) dataFName
75f4dd05c8 Andr*0317       integer i,k,n
                0318       integer ig,jg,tn,iunit
                0319       integer length_of_rec
                0320       integer bi,bj,irec,fileprec
                0321       Real*8 r8seg(nchp)
4ef02e4efb Ed H*0322 
881cd8848f Andr*0323       DO i = 1,80
4ef02e4efb Ed H*0324         bnam(i:i) = ' '
                0325       ENDDO
172027e04f Andr*0326       WRITE(fn,'(a,I10.10)') 'pickup_vegtiles.',Iter
4ef02e4efb Ed H*0327       ilst = ILNBLNK(fn)
172027e04f Andr*0328       WRITE(bnam,'(a,I10.10)') 'pickup_vegtiles.',Iter
75f4dd05c8 Andr*0329       fileprec = 64
72d95bfc5d Andr*0330 
4ef02e4efb Ed H*0331 #ifdef ALLOW_MNC
391fda017a Andr*0332       IF (useMNC.AND. pickup_write_mnc) THEN
4ef02e4efb Ed H*0333 
                0334 C       Write fizhi veg-space variables using the MNC package
1279bcbdce Ed H*0335         CALL MNC_FILE_CLOSE_ALL_MATCHING(bnam, myThid)
4ef02e4efb Ed H*0336         CALL MNC_CW_SET_UDIM(bnam, 1, myThid)
                0337 
                0338 C       fizhi_coms.h
                0339         CALL MNC_CW_RL_R(prec,bnam,0,0,'ctmt', ctmt, myThid)
                0340         CALL MNC_CW_RL_R(prec,bnam,0,0,'xxmt', xxmt, myThid)
                0341         CALL MNC_CW_RL_R(prec,bnam,0,0,'yymt', yymt, myThid)
                0342         CALL MNC_CW_RL_R(prec,bnam,0,0,'zetamt', zetamt, myThid)
                0343         CALL MNC_CW_RL_R(prec,bnam,0,0,'xlmt', xlmt, myThid)
                0344         CALL MNC_CW_RL_R(prec,bnam,0,0,'khmt', khmt, myThid)
                0345         CALL MNC_CW_RL_R(prec,bnam,0,0,'tke', tke, myThid)
                0346 
                0347 C       fizhi_land_coms.h
                0348         CALL MNC_CW_RL_R(prec,bnam,0,0,'tcanopy', tcanopy, myThid)
                0349         CALL MNC_CW_RL_R(prec,bnam,0,0,'tdeep', tdeep, myThid)
                0350         CALL MNC_CW_RL_R(prec,bnam,0,0,'ecanopy', ecanopy, myThid)
                0351         CALL MNC_CW_RL_R(prec,bnam,0,0,'swetshal', swetshal, myThid)
                0352         CALL MNC_CW_RL_R(prec,bnam,0,0,'swetroot', swetroot, myThid)
                0353         CALL MNC_CW_RL_R(prec,bnam,0,0,'swetdeep', swetdeep, myThid)
                0354         CALL MNC_CW_RL_R(prec,bnam,0,0,'snodep', snodep, myThid)
                0355         CALL MNC_CW_RL_R(prec,bnam,0,0,'capac', capac, myThid)
                0356 
                0357       ENDIF
391fda017a Andr*0358 #endif /*  Not ALLOW_MNC sequence */
75f4dd05c8 Andr*0359 
                0360       call MDSFINDUNIT( iunit, mythid )
                0361       length_of_rec=MDS_RECLEN( fileprec, nchp, mythid )
                0362 
                0363       DO bj = myByLo(myThid), myByHi(myThid)
                0364       DO bi = myBxLo(myThid), myBxHi(myThid)
                0365 
                0366 #ifdef ALLOW_EXCH2
c424ee7cc7 Jean*0367        tn = W2_myTileList(bi,bj)
172027e04f Andr*0368        iG = tn
                0369        jG = 1
75f4dd05c8 Andr*0370 #else
                0371        iG = bi+(myXGlobalLo-1)/sNx
                0372        jG = bj+(myYGlobalLo-1)/sNy
                0373        tn = (jG - 1)*(nPx*nSx) + iG
                0374 #endif /* ALLOW_EXCH2 */
                0375 
de57a2ec4b Mart*0376        write(dataFname,'(2a,i3.3,a,i3.3,a)')
a92e2d51b6 Andr*0377      &              fn(1:ilst),'.',iG,'.',jG,'.data'
de57a2ec4b Mart*0378        print *,' Opening ',dataFName(1:ilst+13)
660d83f1cd Andr*0379        open( iUnit, file=dataFName, status='old',
75f4dd05c8 Andr*0380      &       access='direct', recl=length_of_rec )
                0381 
                0382        irec = 0
                0383 C First read single-level turbulence fields
                0384        read(iunit,rec=1) r8seg
                0385 #ifdef _BYTESWAPIO
                0386        call MDS_BYTESWAPR8( nchp, r8seg )
                0387 #endif
                0388        do n = 1,nchp
                0389         ctmt(n,bi,bj) = r8seg(n)
                0390        enddo
                0391 
                0392        read(iunit,rec=2) r8seg
                0393 #ifdef _BYTESWAPIO
                0394        call MDS_BYTESWAPR8( nchp, r8seg )
                0395 #endif
                0396        do n = 1,nchp
                0397         xxmt(n,bi,bj) = r8seg(n)
                0398        enddo
                0399 
                0400        read(iunit,rec=3) r8seg
                0401 #ifdef _BYTESWAPIO
                0402        call MDS_BYTESWAPR8( nchp, r8seg )
                0403 #endif
                0404        do n = 1,nchp
                0405         yymt(n,bi,bj) = r8seg(n)
                0406        enddo
                0407 
                0408        read(iunit,rec=4) r8seg
                0409 #ifdef _BYTESWAPIO
                0410        call MDS_BYTESWAPR8( nchp, r8seg )
                0411 #endif
                0412        do n = 1,nchp
                0413         zetamt(n,bi,bj) = r8seg(n)
                0414        enddo
                0415 
                0416 C And now read Multi-level turbulence fields
                0417        do k = 1,Nrphys
                0418         irec = 4 + 0*Nrphys + k
                0419         read(iunit,rec=irec) r8seg
                0420 #ifdef _BYTESWAPIO
                0421         call MDS_BYTESWAPR8( nchp, r8seg )
                0422 #endif
                0423         do n = 1,nchp
                0424          xlmt(n,k,bi,bj) = r8seg(n)
                0425         enddo
                0426        enddo
                0427 
                0428        do k = 1,Nrphys
                0429         irec = 4 + 1*Nrphys + k
                0430         read(iunit,rec=irec) r8seg
                0431 #ifdef _BYTESWAPIO
                0432         call MDS_BYTESWAPR8( nchp, r8seg )
                0433 #endif
                0434         do n = 1,nchp
                0435          khmt(n,k,bi,bj) = r8seg(n)
                0436         enddo
                0437        enddo
                0438 
                0439        do k = 1,Nrphys
                0440         irec = 4 + 2*Nrphys + k
                0441         read(iunit,rec=irec) r8seg
                0442 #ifdef _BYTESWAPIO
                0443         call MDS_BYTESWAPR8( nchp, r8seg )
                0444 #endif
                0445         do n = 1,nchp
                0446          tke(n,k,bi,bj) = r8seg(n)
                0447         enddo
                0448        enddo
                0449 
                0450 C And finally, read land surface fields
                0451        irec = 4 + 3*Nrphys + 1
                0452        read(iunit,rec=irec) r8seg
                0453 #ifdef _BYTESWAPIO
                0454        call MDS_BYTESWAPR8( nchp, r8seg )
                0455 #endif
                0456        do n = 1,nchp
                0457         tcanopy(n,bi,bj) = r8seg(n)
                0458        enddo
                0459 
                0460        irec = 4 + 3*Nrphys + 2
                0461        read(iunit,rec=irec) r8seg
                0462 #ifdef _BYTESWAPIO
                0463        call MDS_BYTESWAPR8( nchp, r8seg )
                0464 #endif
                0465        do n = 1,nchp
                0466         tdeep(n,bi,bj) = r8seg(n)
                0467        enddo
                0468 
                0469        irec = 4 + 3*Nrphys + 3
                0470        read(iunit,rec=irec) r8seg
                0471 #ifdef _BYTESWAPIO
                0472        call MDS_BYTESWAPR8( nchp, r8seg )
                0473 #endif
                0474        do n = 1,nchp
                0475         ecanopy(n,bi,bj) = r8seg(n)
                0476        enddo
                0477 
                0478        irec = 4 + 3*Nrphys + 4
                0479        read(iunit,rec=irec) r8seg
                0480 #ifdef _BYTESWAPIO
                0481        call MDS_BYTESWAPR8( nchp, r8seg )
                0482 #endif
                0483        do n = 1,nchp
                0484         swetshal(n,bi,bj) = r8seg(n)
                0485        enddo
                0486 
                0487        irec = 4 + 3*Nrphys + 5
                0488        read(iunit,rec=irec) r8seg
                0489 #ifdef _BYTESWAPIO
                0490        call MDS_BYTESWAPR8( nchp, r8seg )
                0491 #endif
                0492        do n = 1,nchp
                0493         swetroot(n,bi,bj) = r8seg(n)
                0494        enddo
                0495 
                0496        irec = 4 + 3*Nrphys + 6
                0497        read(iunit,rec=irec) r8seg
                0498 #ifdef _BYTESWAPIO
                0499        call MDS_BYTESWAPR8( nchp, r8seg )
                0500 #endif
                0501        do n = 1,nchp
                0502         swetdeep(n,bi,bj) = r8seg(n)
                0503        enddo
                0504 
                0505        irec = 4 + 3*Nrphys + 7
                0506        read(iunit,rec=irec) r8seg
                0507 #ifdef _BYTESWAPIO
                0508        call MDS_BYTESWAPR8( nchp, r8seg )
                0509 #endif
                0510        do n = 1,nchp
                0511         snodep(n,bi,bj) = r8seg(n)
                0512        enddo
                0513 
                0514        irec = 4 + 3*Nrphys + 8
                0515        read(iunit,rec=irec) r8seg
                0516 #ifdef _BYTESWAPIO
                0517        call MDS_BYTESWAPR8( nchp, r8seg )
                0518 #endif
                0519        do n = 1,nchp
                0520         capac(n,bi,bj) = r8seg(n)
                0521        enddo
                0522 
                0523        close(iunit)
                0524 
                0525 C End of bi bj loop
                0526       enddo
                0527       enddo
                0528 
4ef02e4efb Ed H*0529 
                0530       RETURN
                0531       END
                0532 
                0533 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!