Back to home page

darwin3
 
 

    

File indexing completed on 2024-12-17 18:37:26 UTC

view on githubraw file Latest commit 87dd4f7d on 2024-01-17 18:17:24 UTC
87dd4f7d5f Oliv*0001 #include "OASIM_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: OASIM_LOAD_UNFORMATTED
                0006 
                0007 C     !INTERFACE:
                0008       SUBROUTINE OASIM_LOAD_UNFORMATTED( myTime, myIter, myThid )
                0009 
                0010 C     !DESCRIPTION:
                0011 C     Load input fields OASIM state package.
                0012 C     For now very simple-minded: no interplation, fields stay the same
                0013 C     throughout month.
                0014 
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
                0020 #include "OASIM_SIZE.h"
                0021 #include "OASIM_PARAMS.h"
                0022 #include "OASIM_FIELDS.h"
                0023 #ifdef ALLOW_CAL
                0024 #include "cal.h"
                0025 #endif
                0026 
                0027 C     !INPUT PARAMETERS:
                0028 C     myTime   :: Current time of simulation ( s )
                0029 C     myIter   :: Current iteration number in simulation
                0030 C     myThid   :: my Thread Id number
                0031       _RL     myTime
                0032       INTEGER myIter, myThid
                0033 CEOP
                0034 
                0035 #ifdef ALLOW_OASIM
                0036 #ifdef OASIM_READ_UNFORMATTED
                0037 C     !LOCAL VARIABLES:
                0038       LOGICAL newmonth
                0039       INTEGER imon, year
                0040 #ifdef ALLOW_CAL
                0041       INTEGER iday, imono, secs, lp, wd, currentdate(4)
                0042 #else
                0043       _RL monsec
                0044       PARAMETER( monsec = 2592000.0 _d 0 )
                0045 #endif
                0046 #ifdef OASIM_OUTPUT_FORCING
                0047       CHARACTER*(MAX_LEN_FNAM) fileout
                0048       INTEGER l
                0049 #endif
                0050 
                0051 #ifdef ALLOW_CAL
                0052       CALL cal_GetDate( myiter-1,mytime-deltaTclock,currentdate,mythid )
                0053       CALL cal_convDate( currentdate,year,imono,iday,secs,lp,wd,myThid )
                0054       CALL cal_GetDate( myiter, mytime, currentdate, mythid )
                0055       CALL cal_convDate( currentdate,year,imon,iday,secs,lp,wd,myThid )
                0056       newmonth = imon .NE. imono
                0057 c      ndmo = nDayMonth(imon, currentdate(3))
                0058 #else
                0059 C     assume run starts Jan.1 of oasim_startYear and month has 30 days
                0060       imon = FLOOR((myTime+0.5 _d 0*deltaTclock)/monsec)
                0061       newmonth = imon .NE. FLOOR((myTime-0.5 _d 0*deltaTclock)/monsec)
                0062       year = imon/12
                0063       imon = imon - 12*year + 1
                0064       year = oasim_startYear + year
                0065 c      ndmo = 30
                0066 #endif
                0067 
                0068 C     keep the same field throughout the month
                0069       IF ( myIter .EQ. nIter0 .OR. newmonth ) THEN
                0070         CALL OASIM_READ( year, imon, myThid )
                0071 
                0072 #ifdef OASIM_OUTPUT_FORCING
                0073         WRITE(fileout,'(A,I4)')'o_ccov_', year
                0074         CALL WRITE_REC_XY_RL(fileout, ccov, imon, myIter, myThid )
                0075         WRITE(fileout,'(A,I4)')'o_rlwp_', year
                0076         CALL WRITE_REC_XY_RL(fileout, rlwp, imon, myIter, myThid )
                0077         WRITE(fileout,'(A,I4)')'o_cdre_', year
                0078         CALL WRITE_REC_XY_RL(fileout, cdre, imon, myIter, myThid )
                0079         WRITE(fileout,'(A,I4)')'o_slp_', year
                0080         CALL WRITE_REC_XY_RL(fileout, slp, imon, myIter, myThid )
                0081         WRITE(fileout,'(A,I4)')'o_wsm_', year
                0082         CALL WRITE_REC_XY_RL(fileout, wsm, imon, myIter, myThid )
                0083         WRITE(fileout,'(A,I4)')'o_rh_', year
                0084         CALL WRITE_REC_XY_RL(fileout, rh, imon, myIter, myThid )
                0085         WRITE(fileout,'(A,I4)')'o_oz_', year
                0086         CALL WRITE_REC_XY_RL(fileout, oz, imon, myIter, myThid )
                0087         WRITE(fileout,'(A,I4)')'o_wv_', year
                0088         CALL WRITE_REC_XY_RL(fileout, wv, imon, myIter, myThid )
                0089         DO l=1,nlt
                0090          WRITE(fileout,'(A,I3.3,A,I4)')'o_taua', l, '_', year
                0091          CALL WRITE_REC_XY_RL(fileout, taua(1-OLx,1-OLy,1,1,l), imon,
                0092      &         myIter, myThid)
                0093          WRITE(fileout,'(A,I3.3,A,I4)')'o_asymp', l, '_', year
                0094          CALL WRITE_REC_XY_RL(fileout, asymp(1-OLx,1-OLy,1,1,l), imon,
                0095      &         myIter, myThid)
                0096          WRITE(fileout,'(A,I3.3,A,I4)')'o_ssalb', l, '_', year
                0097          CALL WRITE_REC_XY_RL(fileout, ssalb(1-OLx,1-OLy,1,1,l), imon,
                0098      &         myIter, myThid)
                0099         ENDDO
                0100 #endif
                0101       ENDIF
                0102 
                0103 #endif /* OASIM_READ_UNFORMATTED */
                0104 #endif /* ALLOW_OASIM */
                0105 
                0106       RETURN
                0107       END
                0108 
                0109 
                0110 #ifdef OASIM_READ_UNFORMATTED
                0111 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0112 CBOP
                0113 C     !ROUTINE: OASIM_READ
                0114 
                0115 C     !INTERFACE:
                0116       SUBROUTINE OASIM_READ( year, imo, myThid )
                0117 
                0118 C     !DESCRIPTION:
                0119 C     Read oasim data into local arrays
                0120 
                0121 C     !USES:
                0122       IMPLICIT NONE
                0123 #include "SIZE.h"
                0124 #include "EEPARAMS.h"
                0125 #include "GRID.h"
                0126 #include "PARAMS.h"
                0127 #include "OASIM_SIZE.h"
                0128 #include "OASIM_IO_SIZE.h"
                0129 #include "OASIM_PARAMS.h"
                0130 #include "OASIM_FIELDS.h"
                0131 #include "OASIM_INTERNAL.h"
                0132 
                0133 C     !INPUT PARAMETERS:
                0134 C     myThid   :: my Thread Id number
                0135       INTEGER year, imo
                0136       INTEGER myThid
                0137 CEOP
                0138 
                0139 #ifdef ALLOW_OASIM
                0140 
                0141 C     !LOCAL VARIABLES:
                0142       INTEGER i,j,bi,bj,il,jl,l,laer
                0143       _RL w
                0144       _RL slpin(iatm,jatm),wsmin(iatm,jatm),rhin(iatm,jatm)
                0145       _RL ozin(iatm,jatm),wvin(iatm,jatm)
                0146       _RL ccovin(icd,jcd),cldtcin(icd,jcd),rlwpin(icd,jcd)
                0147       _RL cdrein(icd,jcd)
                0148       REAL*4 tauain(icd,jcd,nltaer),asympin(icd,jcd,nltaer)
                0149       REAL*4 ssalbin(icd,jcd,nltaer)
                0150 
                0151       CALL OASIM_READ_CLOUDS(year,imo, ccovin,cldtcin,rlwpin,cdrein,
                0152      &                       myThid)
                0153       CALL OASIM_READ_GASES(year,imo, slpin,wsmin,rhin,ozin,wvin,myThid)
                0154       CALL OASIM_READ_AEROSOLS(year,imo, tauain,asympin,ssalbin,myThid)
                0155 
                0156       DO bj=myByLo(myThid),myByHi(myThid)
                0157       DO bi=myBxLo(myThid),myBxHi(myThid)
                0158       DO j=1,sNy
                0159       DO i=1,sNx
                0160         il = FLOOR(MOD(XC(i,j,bi,bj) + 180.0 _d 0, 360.0 _d 0)) + 1
                0161         jl = FLOOR((YC(i,j,bi,bj) + 90.0 _d 0)) + 1
                0162         ccov (i,j,bi,bj) = ccovin (il,jl)
                0163         rlwp (i,j,bi,bj) = rlwpin (il,jl)
                0164         cdre (i,j,bi,bj) = cdrein (il,jl)
                0165         slp  (i,j,bi,bj) = slpin  (il,jl)
                0166         wsm  (i,j,bi,bj) = wsmin  (il,jl)
                0167         rh   (i,j,bi,bj) = rhin   (il,jl)
                0168         oz   (i,j,bi,bj) = ozin   (il,jl)
                0169         wv   (i,j,bi,bj) = wvin   (il,jl)
                0170         DO l=1,nlt
                0171           laer = iaer(l)
                0172           w = waer(l)
                0173           taua (i,j,bi,bj,l) = w*tauain (il,jl,laer-1)
                0174      &                    + (1-w)*tauain (il,jl,laer)
                0175           asymp(i,j,bi,bj,l) = w*asympin(il,jl,laer-1)
                0176      &                    + (1-w)*asympin(il,jl,laer)
                0177           ssalb(i,j,bi,bj,l) = w*ssalbin(il,jl,laer-1)
                0178      &                    + (1-w)*ssalbin(il,jl,laer)
                0179         ENDDO
                0180       ENDDO
                0181       ENDDO
                0182       ENDDO
                0183       ENDDO
                0184 
                0185 #endif /* ALLOW_OASIM */
                0186 
                0187       RETURN
                0188       END
                0189 
                0190 
                0191 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0192 CBOP
                0193 C     !ROUTINE: OASIM_READ_CLOUDS
                0194 
                0195 C     !INTERFACE:
                0196       SUBROUTINE OASIM_READ_CLOUDS(year,imo,
                0197      O             ccov1,cldtc1,rlwp1,cdre1,mythid)
                0198 
                0199 C     !DESCRIPTION:
                0200 C     Read cloud data from modcldYYYY.dat and cldYYYY.dat
                0201 C
                0202 C     - ccov1, rlwp1 taken from oasim_cloudCoverFile (ISCCP) if exists
                0203 C       else from oasim_cloudCoverClimFile
                0204 C     - cldtc1, cdre1 taken from oasim_modisCloudFile if exists and has
                0205 C       any valid data, else from oasim_cloudClimFile
                0206 C
                0207 C     cldtc1 is not actually used by the cloud model, the optical
                0208 C     thickness is computed from rlwp1 and cdre1.
                0209 
                0210 C     !USES:
                0211       IMPLICIT NONE
                0212 #include "SIZE.h"
                0213 #include "EEPARAMS.h"
                0214 #include "PARAMS.h"
                0215 #include "OASIM_SIZE.h"
                0216 #include "OASIM_IO_SIZE.h"
                0217 #include "OASIM_PARAMS.h"
                0218 
                0219 C     !INPUT PARAMETERS:
                0220       INTEGER year, imo
                0221       INTEGER mythid
                0222 
                0223 C     !OUTPUT PARAMETERS:
                0224 C     ccov1  :: cloud cover in percent
                0225 C     rlwp1  :: liquid water path
                0226 C     cldtc1 :: optical thickness
                0227 C     cdre1  :: effective droplet radius
                0228       _RL cldtc1(icd,jcd), cdre1(icd,jcd)
                0229       _RL ccov1(icd,jcd), rlwp1(icd,jcd)
                0230 CEOP
                0231 
                0232 #ifdef ALLOW_OASIM
                0233 
                0234 C     !FUNCTIONS:
                0235       INTEGER  ILNBLNK
                0236       EXTERNAL ILNBLNK
                0237 
                0238 C     !LOCAL VARIABLES:
                0239       REAL*4 ccovm(icd,jcd),cldtcm(icd,jcd)
                0240       REAL*4 rlwpm(icd,jcd),cdrem(icd,jcd)
                0241       REAL*4 ccovi(icd,jcd),cldtci(icd,jcd)
                0242       REAL*4 rlwpi(icd,jcd)
                0243       INTEGER*4 imc, jmc
                0244       INTEGER i, ic, ierrmodcld, il, immo, iUnit
                0245       INTEGER j, j1, jc, jc1, m, l, nre, ios
                0246       _RL avgisccp, avgre, refac, sumre, covmax, taumax
                0247       CHARACTER*(MAX_LEN_FNAM) fileout
                0248       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0249 
                0250 c Use MODIS clouds for re and tc
                0251       ierrmodcld = 1
                0252 
                0253       CALL MDSFINDUNIT(iUnit, myThid)
                0254 
                0255 c  Try transient data if given
                0256       il = ILNBLNK( oasim_modisCloudFile )
                0257       WRITE(fileout,'(a,i4.4,a)')
                0258      &     oasim_modisCloudFile(1:il),year,'.dat'
                0259       IF ( debugLevel .GE. debLevB ) THEN
                0260         il = ILNBLNK( fileout )
                0261         WRITE(msgBuf,'(A,A)')
                0262      &   ' OASIM_FIELDS_LOAD: opening global file: ',fileout(1:il)
                0263         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0264      &                      SQUEEZE_RIGHT , myThid)
                0265       ENDIF
                0266       OPEN(iUnit,FILE=fileout,STATUS='old',FORM='unformatted',
                0267      &     CONVERT='LITTLE_ENDIAN',IOSTAT=ios)
                0268       IF (ios .eq. 0) THEN
                0269       READ(iUnit)imc,jmc
                0270 c  Read out up until and including present month
                0271       DO m = 1,imo
                0272        READ(iUnit)ccovm,cldtcm,rlwpm,cdrem
                0273       ENDDO
                0274 c  Check for valid data
                0275       DO j = 1,jcd
                0276        DO i = 1,icd
                0277         IF (ccovm(i,j) .GT. 0.0 _d 0)ierrmodcld = 0
                0278        ENDDO
                0279       ENDDO
                0280       ELSE
                0281        il = ILNBLNK( fileout )
                0282        WRITE(msgBuf,'(3A)') 'OASIM_FIELDS_LOAD:',
                0283      &   ' could not open modisCloudFile,', fileout(1:il)
                0284        CALL PRINT_MESSAGE( msgBuf , errorMessageUnit,
                0285      &                     SQUEEZE_RIGHT , myThid)
                0286        WRITE(msgBuf,'(2A)') 'OASIM_FIELDS_LOAD:',
                0287      &   ' trying climatology'
                0288        CALL PRINT_MESSAGE( msgBuf , errorMessageUnit,
                0289      &                     SQUEEZE_RIGHT , myThid)
                0290       ENDIF
                0291       CLOSE(iUnit)
                0292 c  If no valid data, try climatological data if given
                0293       IF (ierrmodcld .eq. 1 .AND. oasim_cloudClimFile.NE.' ') THEN
                0294         il = ILNBLNK( oasim_cloudClimFile )
                0295         WRITE(fileout,'(a)')
                0296      &       oasim_cloudClimFile(1:il)
                0297         IF ( debugLevel .GE. debLevB ) THEN
                0298           il = ILNBLNK( fileout )
                0299           WRITE(msgBuf,'(A,A)')
                0300      &     ' OASIM_FIELDS_LOAD: opening global file: ',fileout(1:il)
                0301           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0302      &                        SQUEEZE_RIGHT , myThid)
                0303         ENDIF
                0304         OPEN(iUnit,FILE=fileout,STATUS='old',FORM='unformatted',
                0305      &       CONVERT='LITTLE_ENDIAN')
                0306         READ(iUnit)imc,jmc
                0307 c  Read out up until and including present month
                0308         DO m = 1,imo
                0309          READ(iUnit)ccovm,cldtcm,rlwpm,cdrem
                0310         ENDDO
                0311         CLOSE(iUnit)
                0312         ierrmodcld = 0
                0313       ENDIF
                0314       IF (ierrmodcld .eq. 0) THEN
                0315         cldtc1 = cldtcm
                0316 c   Normalize re to ISCCP avg = (10.0 _d 0+11.8 _d 0)/2um = mean of Kiehl and Han
                0317         sumre = 0.0 _d 0
                0318         nre = 0
                0319         DO j = 1,jcd
                0320         DO i = 1,icd
                0321          IF (cdrem(i,j) .GE. 0.0 _d 0)THEN
                0322           sumre = sumre + cdrem(i,j)
                0323           nre = nre+1
                0324          ENDIF
                0325         ENDDO
                0326         ENDDO
                0327         avgre = sumre/float(nre)
                0328         avgisccp = (10.0 _d 0+11.8 _d 0)/2.0 _d 0
                0329         refac = avgisccp/avgre
                0330         DO j = 1,jcd
                0331          DO i = 1,icd
                0332           IF (cdrem(i,j) .GE. 0.0 _d 0)THEN
                0333            cdre1(i,j) = refac*cdrem(i,j)
                0334           ELSE
                0335            cdre1(i,j) = cdrem(i,j)
                0336           ENDIF
                0337          ENDDO
                0338         ENDDO
                0339       ENDIF
                0340 c Use ISCCP clouds for cover and LWP
                0341       il = ILNBLNK( oasim_cloudCoverFile )
                0342       WRITE(fileout,'(a,i4.4,a)')
                0343      &     oasim_cloudCoverFile(1:il),year,'.dat'
                0344       IF ( debugLevel .GE. debLevB ) THEN
                0345         il = ILNBLNK( fileout )
                0346         WRITE(msgBuf,'(A,A)')
                0347      &   ' OASIM_FIELDS_LOAD: opening global file: ',fileout(1:il)
                0348         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0349      &                      SQUEEZE_RIGHT , myThid)
                0350       ENDIF
                0351       OPEN(iUnit,FILE=fileout,STATUS='old',FORM='unformatted',
                0352      &     CONVERT='LITTLE_ENDIAN',IOSTAT=ios)
                0353       IF (ios .ne. 0) THEN
                0354        il = ILNBLNK( fileout )
                0355        WRITE(msgBuf,'(3A)') 'OASIM_FIELDS_LOAD:',
                0356      &   ' could not open CloudCoverFile,', fileout(1:il)
                0357        CALL PRINT_MESSAGE( msgBuf , errorMessageUnit,
                0358      &                     SQUEEZE_RIGHT , myThid)
                0359        WRITE(msgBuf,'(2A)') 'OASIM_FIELDS_LOAD:',
                0360      &   ' trying climatology'
                0361        CALL PRINT_MESSAGE( msgBuf , errorMessageUnit,
                0362      &                     SQUEEZE_RIGHT , myThid)
                0363        OPEN(iUnit,FILE=OASIM_CloudCoverClimFile,STATUS='old',
                0364      &      FORM='unformatted',CONVERT='LITTLE_ENDIAN',IOSTAT=ios)
                0365       ENDIF
                0366       READ(iUnit)imc,jmc
                0367 c  Read out up until and including present month
                0368       DO m = 1,imo
                0369        READ(iUnit)ccovi,cldtci,rlwpi
                0370       ENDDO
                0371       CLOSE(iUnit)
                0372       ccov1 = ccovi
                0373       rlwp1 = rlwpi
                0374       IF (ierrmodcld .eq. 1)THEN
                0375        cdre1 = -1.0 _d 10
                0376       ENDIF
                0377 c
                0378       taumax = -9999.0
                0379       covmax = -9999.0
                0380 c
                0381 C fill in data outside range of satellite from last valid point in the
                0382 C south and north
                0383       DO jc = 1,jcd
                0384        DO ic = 1,icd
                0385         IF (ccov1(ic,jc) .LT. 0.0 _d 0)THEN
                0386          jc1 = max(jc-1,1)
                0387          ccov1(ic,jc) = ccov1(ic,jc1)
                0388         ENDIF
                0389         IF (ccov1(ic,jc) .LT. 0.0 _d 0)THEN
                0390          jc1 = jc+1
                0391          jc1 = min(jc1,jcd)
                0392          DO WHILE (ccov1(ic,jc1) .LT. 0.0 _d 0 .AND. jc1 .LT. jcd)
                0393           jc1 = jc1+1
                0394          ENDDO
                0395          ccov1(ic,jc) = ccov1(ic,jc1)
                0396         ENDIF
                0397 c
                0398         IF (cldtc1(ic,jc) .LT. 0.0 _d 0)THEN
                0399          jc1 = max(jc-1,1)
                0400          cldtc1(ic,jc) = cldtc1(ic,jc1)
                0401         ENDIF
                0402         IF (cldtc1(ic,jc) .LT. 0.0 _d 0)THEN
                0403          jc1 = jc+1
                0404          jc1 = min(jc1,jcd)
                0405          DO WHILE (cldtc1(ic,jc1) .LT. 0.0 _d 0 .AND. jc1 .LT. jcd)
                0406           jc1 = jc1+1
                0407          ENDDO
                0408          cldtc1(ic,jc) = cldtc1(ic,jc1)
                0409         ENDIF
                0410 c
                0411         IF (rlwp1(ic,jc) .LT. 0.0 _d 0)THEN
                0412          jc1 = max(jc-1,1)
                0413          rlwp1(ic,jc) = rlwp1(ic,jc1)
                0414         ENDIF
                0415         IF (rlwp1(ic,jc) .LT. 0.0 _d 0)THEN
                0416          jc1 = jc+1
                0417          jc1 = min(jc1,jcd)
                0418          DO WHILE (rlwp1(ic,jc1) .LT. 0.0 _d 0 .AND. jc1 .LT. jcd)
                0419           jc1 = jc1+1
                0420          ENDDO
                0421          rlwp1(ic,jc) = rlwp1(ic,jc1)
                0422         ENDIF
                0423 c
                0424         IF (ierrmodcld .eq. 0)THEN
                0425          IF (cdre1(ic,jc) .LT. 0.0 _d 0)THEN
                0426           jc1 = max(jc-1,1)
                0427           cdre1(ic,jc) = cdre1(ic,jc1)
                0428          ENDIF
                0429          IF (cdre1(ic,jc) .LT. 0.0 _d 0)THEN
                0430           jc1 = jc+1
                0431           jc1 = min(jc1,jcd)
                0432           DO WHILE (cdre1(ic,jc1) .LT. 0.0 _d 0 .AND. jc1 .LT. jcd)
                0433            jc1 = jc1+1
                0434           ENDDO
                0435           cdre1(ic,jc) = cdre1(ic,jc1)
                0436          ENDIF
                0437         ENDIF
                0438 c   find min/max
                0439         IF (ccov1(ic,jc) .GT. covmax)THEN
                0440          covmax = ccov1(ic,jc)
                0441         ENDIF
                0442         IF (cldtc1(ic,jc) .GT. taumax)THEN
                0443          taumax = cldtc1(ic,jc)
                0444         ENDIF
                0445        ENDDO
                0446       ENDDO
                0447 
                0448       IF (taumax .LT. 0.0 _d 0)THEN
                0449        cdre1 = -1.0 _d 10
                0450        ierrmodcld = 1
                0451       ENDIF
                0452 
                0453       IF (covmax .LE. 0.0 _d 0)THEN
                0454        WRITE(msgBuf,'(2A,I4,X,I2)') 'OASIM_READ_CLOUDS: ',
                0455      &      'invalid cloud data for ',year,imo
                0456        CALL PRINT_ERROR( msgBuf , myThid)
                0457        STOP 'ABNORMAL END: S/R OASIM_READ_CLOUDS: INVALID CLOUD DATA'
                0458       ENDIF
                0459 
                0460 #endif /* ALLOW_OASIM */
                0461 
                0462       RETURN
                0463       END
                0464 
                0465 
                0466 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0467 CBOP
                0468 C     !ROUTINE: OASIM_READ_GASES
                0469 
                0470 C     !INTERFACE:
                0471       SUBROUTINE OASIM_READ_GASES(year,imo,
                0472      O      slp1,wsm1,rh1,oz1,wv1,
                0473      I      mythid)
                0474 
                0475 C     !DESCRIPTION:
                0476 C     Read gas concentrations from optYYYY.dat
                0477 
                0478 C     !USES:
                0479       IMPLICIT NONE
                0480 #include "SIZE.h"
                0481 #include "EEPARAMS.h"
                0482 #include "PARAMS.h"
                0483 #include "OASIM_SIZE.h"
                0484 #include "OASIM_IO_SIZE.h"
                0485 #include "OASIM_PARAMS.h"
                0486 
                0487 C     !INPUT PARAMETERS:
                0488       INTEGER year, imo
                0489       INTEGER myThid
                0490 
                0491 C     !OUTPUT PARAMETERS:
                0492       _RL slp1(iatm,jatm),wsm1(iatm,jatm),rh1(iatm,jatm)
                0493       _RL oz1(iatm,jatm),wv1(iatm,jatm)
                0494 CEOP
                0495 
                0496 #ifdef ALLOW_OASIM
                0497 
                0498 C     !FUNCTIONS:
                0499       INTEGER  ILNBLNK
                0500       EXTERNAL ILNBLNK
                0501 
                0502 C     !LOCAL VARIABLES:
                0503       REAL*4 slporg(iatm,jatm),wsmorg(iatm,jatm),rhorg(iatm,jatm)
                0504       REAL*4 ozorg(iatm,jatm),wvorg(iatm,jatm)
                0505       INTEGER*4 imc, jmc
                0506       INTEGER i, il, iUnit
                0507       INTEGER j, j1, m
                0508       CHARACTER*(MAX_LEN_FNAM) fileout
                0509       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0510 
                0511       CALL MDSFINDUNIT(iUnit, myThid)
                0512 
                0513       il = ILNBLNK( oasim_opticsFile )
                0514       WRITE(fileout,'(a,i4.4,a)')
                0515      &     oasim_opticsFile(1:il),year,'.dat'
                0516       IF ( debugLevel .GE. debLevB ) THEN
                0517         il = ILNBLNK( fileout )
                0518         WRITE(msgBuf,'(A,A)')
                0519      &   ' OASIM_FIELDS_LOAD: opening global file: ',fileout(1:il)
                0520         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0521      &                      SQUEEZE_RIGHT , myThid)
                0522       ENDIF
                0523       OPEN(iUnit,FILE=fileout,STATUS='old',FORM='unformatted',
                0524      &     CONVERT='LITTLE_ENDIAN')
                0525       READ(iUnit)imc,jmc
                0526       DO m = 1,imo
                0527        READ(iUnit)slporg,wsmorg,rhorg,ozorg,wvorg
                0528       ENDDO
                0529       CLOSE(iUnit)
                0530 c
                0531       DO j = 1,jatm
                0532        DO i = 1,iatm
                0533         slp1(i,j) = slporg(i,j)
                0534         rhorg(i,j) = min(rhorg(i,j),100.0 _d 0)  !prevent excess saturation
                0535 C       fill in north and south
                0536         IF (ozorg(i,j) .LT. 0.0 _d 0)THEN
                0537          j1 = max(j-1,1)
                0538          ozorg(i,j) = ozorg(i,j1)
                0539         ENDIF
                0540         IF (ozorg(i,j) .LT. 0.0 _d 0)THEN
                0541          j1 = j+1
                0542          j1 = min(j1,jatm)
                0543          DO WHILE (ozorg(i,j1) .LT. 0.0 _d 0 .AND. j1 .LT. jatm)
                0544           j1 = j1+1
                0545          ENDDO
                0546          ozorg(i,j) = ozorg(i,j1)
                0547         ENDIF
                0548         wsm1(i,j) = wsmorg(i,j)
                0549         rh1(i,j) = rhorg(i,j)
                0550         oz1(i,j) = ozorg(i,j)
                0551         wv1(i,j) = wvorg(i,j)
                0552        ENDDO
                0553       ENDDO
                0554 
                0555 #endif /* ALLOW_OASIM */
                0556 
                0557       RETURN
                0558       END
                0559 
                0560 
                0561 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0562 CBOP
                0563 C     !ROUTINE: OASIM_READ_AEROSOLS
                0564 
                0565 C     !INTERFACE:
                0566       SUBROUTINE OASIM_READ_AEROSOLS(year,imo,
                0567      O                               taua1,asymp1,ssalb1,
                0568      I                               mythid)
                0569 
                0570 C     !DESCRIPTION:
                0571 C     Read in aerosols from modaerYYYYMM.dat
                0572 
                0573 C     !USES:
                0574       IMPLICIT NONE
                0575 #include "SIZE.h"
                0576 #include "EEPARAMS.h"
                0577 #include "PARAMS.h"
                0578 #include "OASIM_SIZE.h"
                0579 #include "OASIM_IO_SIZE.h"
                0580 #include "OASIM_PARAMS.h"
                0581 
                0582 C     !INPUT PARAMETERS:
                0583       INTEGER year, imo
                0584       INTEGER myThid
                0585 
                0586 C     !OUTPUT PARAMETERS:
                0587       REAL*4 taua1(icd,jcd,nltaer),asymp1(icd,jcd,nltaer)
                0588       REAL*4 ssalb1(icd,jcd,nltaer)
                0589 CEOP
                0590 
                0591 #ifdef ALLOW_OASIM
                0592 
                0593 C     !FUNCTIONS:
                0594       INTEGER  ILNBLNK
                0595       EXTERNAL ILNBLNK
                0596 
                0597 C     !LOCAL VARIABLES:
                0598       INTEGER il,ios,i,j,l,immo,iUnit
                0599       _RL flagam
                0600       DATA flagam /-0.01 _d 0/
                0601       REAL*4 avhrrtau(iatm,jatm),avhrrtauclim(iatm,jatm)
                0602       _RL facaer(nltaer)
                0603       CHARACTER*(MAX_LEN_FNAM) fileout
                0604       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0605 
                0606       CALL MDSFINDUNIT(iunit, myThid)
                0607 
                0608 c try modis aerosol file
                0609       taua1 = flagam
                0610       il = ILNBLNK( oasim_aerosolFile )
                0611       WRITE(fileout,'(a,i4.4,i2.2,a)')
                0612      &     oasim_aerosolFile(1:il),year,imo,'.dat'
                0613       IF ( debugLevel .GE. debLevB ) THEN
                0614         il = ILNBLNK( fileout )
                0615         WRITE(msgBuf,'(A,A)')
                0616      &   ' OASIM_FIELDS_LOAD: opening global file: ',fileout(1:il)
                0617         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0618      &                      SQUEEZE_RIGHT , myThid)
                0619       ENDIF
                0620       OPEN(iUnit,FILE=fileout,STATUS='old',FORM='unformatted',
                0621      &     CONVERT='LITTLE_ENDIAN',IOSTAT=ios)
                0622       IF (ios .eq. 0) THEN
                0623 c   sucess!
                0624         READ(iUnit)taua1,asymp1,ssalb1
                0625        CLOSE(iUnit)
                0626       ELSE
                0627        CLOSE(iUnit)
                0628 c   failure:
                0629 c   Read AVHRR file and climatology
                0630        il = ILNBLNK( fileout )
                0631        WRITE(msgBuf,'(3A)') 'OASIM_FIELDS_LOAD:',
                0632      &   ' could not open aerosolFile,', fileout(1:il)
                0633        CALL PRINT_MESSAGE( msgBuf , errorMessageUnit,
                0634      &                     SQUEEZE_RIGHT , myThid)
                0635        WRITE(msgBuf,'(2A)') 'OASIM_FIELDS_LOAD:',
                0636      &   ' trying aerTau file'
                0637        CALL PRINT_MESSAGE( msgBuf , errorMessageUnit,
                0638      &                     SQUEEZE_RIGHT , myThid)
                0639        il = ILNBLNK( oasim_aerTauFile )
                0640        WRITE(fileout,'(a,i4.4,a)')
                0641      &      oasim_aerTauFile(1:il),year,'.dat'
                0642        IF ( debugLevel .GE. debLevB ) THEN
                0643          il = ILNBLNK( fileout )
                0644          WRITE(msgBuf,'(A,A)')
                0645      &    ' OASIM_FIELDS_LOAD: opening global file: ',fileout(1:il)
                0646          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0647      &                       SQUEEZE_RIGHT , myThid)
                0648        ENDIF
                0649        OPEN(iUnit,FILE=fileout,STATUS='old',FORM='unformatted',
                0650      &      CONVERT='LITTLE_ENDIAN',IOSTAT=ios)
                0651        IF (ios .ne. 0) THEN
                0652         il = ILNBLNK( fileout )
                0653         WRITE(msgBuf,'(3A)') 'OASIM_FIELDS_LOAD:',
                0654      &    ' could not open aerTauFile,', fileout(1:il)
                0655         CALL PRINT_ERROR( msgBuf , myThid)
                0656         CALL ALL_PROC_DIE( 0 )
                0657         STOP 'ABNORMAL END: S/R OASIM_FIELDS_LOAD'
                0658        ENDIF
                0659        DO immo = 1,imo
                0660         READ(iUnit)avhrrtau     !taua at 0.63um
                0661        ENDDO
                0662        CLOSE(iUnit)
                0663 c   get monthly climatology for missing data
                0664        il = ILNBLNK( oasim_aerTauClimFile )
                0665        WRITE(fileout,'(a)') oasim_aerTauClimFile(1:il)
                0666        IF ( debugLevel .GE. debLevB ) THEN
                0667          il = ILNBLNK( fileout )
                0668          WRITE(msgBuf,'(A,A)')
                0669      &    ' OASIM_FIELDS_LOAD: opening global file: ',fileout(1:il)
                0670          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0671      &                       SQUEEZE_RIGHT , myThid)
                0672        ENDIF
                0673        OPEN(iUnit,FILE=fileout,STATUS='old',FORM='unformatted',
                0674      &      CONVERT='LITTLE_ENDIAN',IOSTAT=ios)
                0675        IF (ios .ne. 0) THEN
                0676         il = ILNBLNK( fileout )
                0677         WRITE(msgBuf,'(3A)') 'OASIM_FIELDS_LOAD:',
                0678      &    ' could not open aerTauClimFile,', fileout(1:il)
                0679         CALL PRINT_ERROR( msgBuf , myThid)
                0680         CALL ALL_PROC_DIE( 0 )
                0681         STOP 'ABNORMAL END: S/R OASIM_FIELDS_LOAD'
                0682        ENDIF
                0683        DO immo = 1,imo
                0684         READ(iUnit)avhrrtauclim
                0685        ENDDO
                0686        CLOSE(iUnit)
                0687        DO j = 1,jatm
                0688         DO i = 1,iatm
                0689          IF (avhrrtau(i,j) .LT. 0.0)THEN
                0690           avhrrtau(i,j) = avhrrtauclim(i,j)
                0691          ENDIF
                0692         ENDDO
                0693        ENDDO
                0694 c   read modis aerosol climatology for reference
                0695        il = ILNBLNK( oasim_aerosolClimFile )
                0696        WRITE(fileout,'(a,i2.2,a)')
                0697      &     oasim_aerosolClimFile(1:il),imo,'.dat'
                0698        IF ( debugLevel .GE. debLevB ) THEN
                0699          il = ILNBLNK( fileout )
                0700          WRITE(msgBuf,'(A,A)')
                0701      &    ' OASIM_FIELDS_LOAD: opening global file: ',fileout(1:il)
                0702          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0703      &                       SQUEEZE_RIGHT , myThid)
                0704        ENDIF
                0705        OPEN(iUnit,FILE=fileout,STATUS='old',FORM='unformatted',
                0706      &      CONVERT='LITTLE_ENDIAN')
                0707        READ(iUnit)taua1,asymp1,ssalb1
                0708        CLOSE(iUnit)
                0709 c     Closest OASIM band is 625 nm; AVHRR is 630 nm
                0710        DO j = 1,jatm
                0711         DO i = 1,iatm
                0712          IF (avhrrtau(i,j) .GE. 0.0)THEN
                0713           DO l = 1,nlt
                0714            facaer(l) = taua1(i,j,l)/taua1(i,j,iAVHRR)
                0715           ENDDO
                0716 c     subtract AVHRR bias (add a negative to a negative bias)
                0717           taua1(i,j,iAVHRR) = avhrrtau(i,j) + 0.025   !625 nm
                0718           DO l = 1,nlt
                0719            taua1(i,j,l) = facaer(l)*taua1(i,j,iAVHRR)
                0720           ENDDO
                0721          ENDIF
                0722         ENDDO
                0723        ENDDO
                0724       ENDIF
                0725 
                0726 #endif /* ALLOW_OASIM */
                0727 
                0728       RETURN
                0729       END
                0730 #endif /* OASIM_READ_UNFORMATTED */
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

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

The LXR team
Valid CSS 2.1! Valid HTML 4.01!