Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:37:20 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
65007c221b Jean*0001 #include "AIM_OPTIONS.h"
f9646b12d5 Jean*0002 
65007c221b Jean*0003 CStartOfInterface
f9646b12d5 Jean*0004       SUBROUTINE AIM_FIELDS_LOAD(
                0005      I                            myTime, myIter, myThid )
65007c221b Jean*0006 C     *==========================================================*
                0007 C     | SUBROUTINE AIM_FIELDS_LOAD
                0008 C     | o Control reading of AIM fields from external source.
                0009 C     *==========================================================*
                0010 C     | Loads surface boundary condition datasets for AIM.
                0011 C     | The routine is called every timetep and periodically
                0012 C     | loads a set of external fields.
                0013 C     | Monthly climatology files are read either for
f9646b12d5 Jean*0014 C     | a) a direct use (useMMsurfFc):
65007c221b Jean*0015 C     |   Albedo, Soil moisture, Surface Temperature
                0016 C     | b) time interpolation (useFMsurfBC):
                0017 C     |   Sea & Land surf. Temp, snow, sea-ice, soil-water (2-lev)
                0018 C     | + (1rst.iter) ground albedo, vegetation, land-sea fraction
40eed150a6 Jean*0019 C     | Most of the work is done by the master thread while
                0020 C     | the other threads spin (but all inside MDSIO S/R).
65007c221b Jean*0021 C     *==========================================================*
                0022       IMPLICIT NONE
f9646b12d5 Jean*0023 
65007c221b Jean*0024 C     === Global variables ===
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "PARAMS.h"
                0028 #include "GRID.h"
                0029 #include "AIM_PARAMS.h"
                0030 c #include "AIM_GRID.h"
                0031 #include "AIM_FFIELDS.h"
f9646b12d5 Jean*0032 
65007c221b Jean*0033 C     === Routine arguments ===
e71a2c0f64 Jean*0034 C     myTime :: Simulation time
                0035 C     myIter :: Simulation timestep number
                0036 C     myThid :: Thread no. that called this routine.
65007c221b Jean*0037       _RL     myTime
                0038       INTEGER myIter
e71a2c0f64 Jean*0039       INTEGER myThid
65007c221b Jean*0040 CEndOfInterface
f9646b12d5 Jean*0041 
65007c221b Jean*0042 C     === Functions ===
                0043 
                0044 #ifdef ALLOW_AIM
                0045 C     === Local variables ===
d0a9461855 Jean*0046 C     bi,bj, i,j  :: Loop counters
                0047 C     tYear       :: Fraction within year of myTime
                0048 C     mnthIndex   :: Current time in whole months
65007c221b Jean*0049 C     prevMnthIndex
d0a9461855 Jean*0050 C     fNam        :: Strings used in constructing file names
65007c221b Jean*0051 C     mnthNam
d0a9461855 Jean*0052 C     pfact       :: used to convert Pot.Temp. to in-situ Temp.
                0053 C     loadNewData :: true when need to load new data from file
65007c221b Jean*0054       INTEGER bi,bj, i, j
d0a9461855 Jean*0055       INTEGER mnthIndex
65007c221b Jean*0056       INTEGER prevMnthIndex
f9646b12d5 Jean*0057       COMMON / LOCAL_AIM_FIELDS_LOAD / prevMnthIndex
d0a9461855 Jean*0058 c     _RL pfact
                0059       LOGICAL loadNewData
65007c221b Jean*0060 C--   for use with useMMsurfFc:
                0061       CHARACTER*(MAX_LEN_FNAM) fNam
                0062       CHARACTER*3 mnthNam(12)
                0063       DATA mnthNam /
                0064      & 'jan', 'feb', 'mar', 'apr', 'may', 'jun',
                0065      & 'jul', 'aug', 'sep', 'oct', 'nov', 'dec' /
                0066       SAVE mnthNam
                0067 C--   for use with useFMsurfBC:
d0a9461855 Jean*0068       INTEGER nm0, nm1, nm2, nm3
                0069       _RL t0prd, tNcyc, tmprd
                0070 
                0071 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0072 
                0073 C--   find which month to use for surface BC
                0074 C     aim_surfForc_TimePeriod :: Length of forcing time period (e.g. 1 month)
                0075 C     aim_surfForc_NppCycle   :: Number of time period per Cycle (e.g. 12)
                0076       t0prd = myTime / aim_surfForc_TimePeriod
                0077       tNcyc = aim_surfForc_NppCycle
                0078 
                0079       IF (aim_useMMsurfFc) THEN
                0080 C-     select the current month :
                0081         tmprd = MOD(t0prd,tNcyc)
                0082         mnthIndex = 1 + INT(tmprd)
                0083       ELSEIF (aim_useFMsurfBC) THEN
                0084         tmprd = t0prd - 0.5 _d 0 + tNcyc
                0085         tmprd = MOD(tmprd,tNcyc)
                0086 C-     select indices of previous month (nm0) and next month (nm1):
                0087         nm0 = 1 + INT(tmprd)
                0088         nm1 = 1 + MOD(nm0,aim_surfForc_NppCycle)
                0089         mnthIndex = nm0
                0090       ELSE
                0091         RETURN
                0092       ENDIF
65007c221b Jean*0093 
d0a9461855 Jean*0094 C--   decide if it is time to load new data
                0095       IF ( myIter.EQ.nIter0 ) THEN
                0096         loadNewData = .TRUE.
                0097       ELSE
                0098         IF ( mnthIndex .NE. prevMnthIndex ) THEN
                0099 C-      switch to a new time record
                0100           loadNewData = .TRUE.
                0101         ELSE
                0102           loadNewData = .FALSE.
                0103         ENDIF
                0104       ENDIF
f9646b12d5 Jean*0105 
40eed150a6 Jean*0106 C  note: reading/writing 2-D/3-D field with MDS-IO S/R is thread safe;
                0107 C        => no need for BARRIER call before/after loading fileds
                0108 
65007c221b Jean*0109       IF (aim_useMMsurfFc) THEN
                0110 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0111 C-- Use Monthly Mean surface forcing fields:
                0112 
d0a9461855 Jean*0113        IF ( loadNewData ) THEN
65007c221b Jean*0114 C-    New month so load in data
                0115 
40eed150a6 Jean*0116 C-    Only one thread updates parameter in common block
                0117 C-    Wait for everyone to set loadNewData before Master updates prevMnthIndex
                0118          _BARRIER
65007c221b Jean*0119          _BEGIN_MASTER( myThid )
                0120          prevMnthIndex = mnthIndex
f9646b12d5 Jean*0121          _END_MASTER( myThid   )
                0122 
65007c221b Jean*0123 C        o Albedo ( convert % to fraction )
                0124          WRITE(fNam,'(A,A,A)' ) 'salb.',
                0125      &         mnthNam(mnthIndex), aim_MMsufx(1:aim_MMsufxLength)
d0a9461855 Jean*0126          CALL READ_REC_XY_RS( fNam, aim_albedo, 1, myIter, myThid )
65007c221b Jean*0127 
                0128 C        o Surface temperature ( in kelvin )
f9646b12d5 Jean*0129          IF (aim_surfPotTemp) THEN
                0130           WRITE(fNam,'(A,A,A)' )'stheta.',
65007c221b Jean*0131      &         mnthNam(mnthIndex), aim_MMsufx(1:aim_MMsufxLength)
f9646b12d5 Jean*0132          ELSE
                0133           WRITE(fNam,'(A,A,A)' )'sTemp.',
65007c221b Jean*0134      &         mnthNam(mnthIndex), aim_MMsufx(1:aim_MMsufxLength)
f9646b12d5 Jean*0135          ENDIF
d0a9461855 Jean*0136          CALL READ_REC_XY_RS( fNam, aim_sst0, 1, myIter, myThid )
65007c221b Jean*0137 
f9646b12d5 Jean*0138 C        o Soil moisture
65007c221b Jean*0139          WRITE(fNam,'(A,A,A)' ) 'smoist.',
                0140      &         mnthNam(mnthIndex), aim_MMsufx(1:aim_MMsufxLength)
d0a9461855 Jean*0141          CALL READ_REC_XY_RS( fNam, aim_sw10, 1, myIter, myThid )
f9646b12d5 Jean*0142 
65007c221b Jean*0143 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0144 
                0145 C--  Converts fields for direct use in Atmos. Physics routine.
                0146 C     better here rather than in "aim_do_atmos" since:
                0147 C     a) change together conversion factor and input file name.
f9646b12d5 Jean*0148 C     b) conversion applied only 1 time / month ;
65007c221b Jean*0149 C     c) easy to check here (variable in common).
                0150 
f9646b12d5 Jean*0151          DO bj = myByLo(myThid), myByHi(myThid)
                0152           DO bi = myBxLo(myThid), myBxHi(myThid)
65007c221b Jean*0153 
                0154 C-  Converts surface albedo : input data is in % 0-100
60bdc7bf26 Alis*0155 C     and Franco s package needs a fraction between 0-1
65007c221b Jean*0156            DO j=1,sNy
                0157             DO i=1,sNx
                0158              aim_albedo(I,J,bi,bj) = aim_albedo(I,J,bi,bj)/100.
                0159             ENDDO
                0160            ENDDO
                0161 
                0162 C-  Converts soil moisture (case input is in cm in bucket of depth 20cm.)
                0163 c          DO j=1,sNy
                0164 c           DO i=1,sNx
d0a9461855 Jean*0165 c            aim_sw10(I,J,bi,bj) = aim_sw10(I,J,bi,bj)
65007c221b Jean*0166 c    &                                   /20.
                0167 c           ENDDO
                0168 c          ENDDO
f9646b12d5 Jean*0169 
                0170 C--   Correct for truncation (because of hFacMin) of surface reference
65007c221b Jean*0171 C      pressure Ro_surf that affects Surf.Temp. :
                0172            DO j=1,sNy
                0173             DO i=1,sNx
                0174 c            pfact = (Ro_surf(i,j,bi,bj)/atm_Po)**atm_kappa
d0a9461855 Jean*0175              aim_sst0(i,j,bi,bj) = aim_sst0(i,j,bi,bj)
                0176      &                           * truncSurfP(i,j,bi,bj)
65007c221b Jean*0177             ENDDO
                0178            ENDDO
                0179 
                0180 C-- end bi,bj loops
                0181           ENDDO
                0182          ENDDO
                0183 
f9646b12d5 Jean*0184          IF (myIter.EQ.nIter0) THEN
e71a2c0f64 Jean*0185           CALL WRITE_FLD_XY_RS( 'aim_Tsurf',' ', aim_sst0, 0, myThid )
f9646b12d5 Jean*0186          ENDIF
65007c221b Jean*0187 
                0188 C-     endif New month - load in data
                0189        ENDIF
                0190 
                0191       ELSEIF (aim_useFMsurfBC) THEN
                0192 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0193 C-- Use Franco Molteni surface BC:
f9646b12d5 Jean*0194 C    take part of S/R INFORC + part of S/R FORDATE (albedo)
65007c221b Jean*0195 C    of the F.Molteni SPEEDY code (ver23)
                0196 
f9646b12d5 Jean*0197        IF ( myIter.EQ.nIter0 ) THEN
65007c221b Jean*0198         DO bj = myByLo(myThid), myByHi(myThid)
f9646b12d5 Jean*0199          DO bi = myBxLo(myThid), myBxHi(myThid)
65007c221b Jean*0200           DO j=1-Oly,sNy+Oly
                0201            DO i=1-Olx,sNx+Olx
f9646b12d5 Jean*0202 c           aim_landFr(i,j,bi,bj)= 0.
                0203             aim_albedo(i,j,bi,bj)= 0.
                0204             aim_veget(i,j,bi,bj) = 0.
65007c221b Jean*0205             aim_sst0(i,j,bi,bj) =300.
                0206             aim_lst0(i,j,bi,bj) =300.
                0207             aim_oic0(i,j,bi,bj) = 0.
                0208             aim_snw0(i,j,bi,bj) = 0.
                0209             aim_sw10(i,j,bi,bj) = 0.
                0210             aim_sw20(i,j,bi,bj) = 0.
5e328a6c4a Davi*0211             aim_qfx0(i,j,bi,bj) = 0.
65007c221b Jean*0212             aim_sst1(i,j,bi,bj) =300.
                0213             aim_lst1(i,j,bi,bj) =300.
                0214             aim_oic1(i,j,bi,bj) = 0.
                0215             aim_snw1(i,j,bi,bj) = 0.
                0216             aim_sw11(i,j,bi,bj) = 0.
                0217             aim_sw21(i,j,bi,bj) = 0.
5e328a6c4a Davi*0218             aim_qfx1(i,j,bi,bj) = 0.
65007c221b Jean*0219            ENDDO
                0220           ENDDO
                0221          ENDDO
                0222         ENDDO
                0223        ENDIF
                0224 
40eed150a6 Jean*0225 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0226 
d0a9461855 Jean*0227        IF ( loadNewData ) THEN
65007c221b Jean*0228 C-     Load new data:
                0229 
40eed150a6 Jean*0230 C-    Only one thread updates parameter in common block
                0231 C-    Wait for everyone to set loadNewData before Master updates prevMnthIndex
                0232         _BARRIER
d0a9461855 Jean*0233         _BEGIN_MASTER( myThid )
                0234         prevMnthIndex = mnthIndex
f9646b12d5 Jean*0235         _END_MASTER( myThid )
65007c221b Jean*0236 
f9646b12d5 Jean*0237         IF ( myIter.EQ.nIter0 ) THEN
                0238 C-      Load Fixed Forcing only at the 1rst iter:
65007c221b Jean*0239 
f9646b12d5 Jean*0240 c        IF ( aim_LandFile .NE. ' '  ) THEN
4b996cbf32 Jean*0241 c         CALL READ_REC_XY_RS(aim_LandFile,aim_landFr,1,myIter,myThid)
                0242 c        ENDIF
f9646b12d5 Jean*0243          IF ( aim_albFile .NE. ' '  ) THEN
65007c221b Jean*0244           CALL READ_REC_XY_RS(aim_albFile,aim_albedo, 1,myIter,myThid)
                0245          ENDIF
                0246 c           alb0(i,j) = 0.01*r4inp(i,j)
f9646b12d5 Jean*0247          IF ( aim_vegFile .NE. ' '  ) THEN
65007c221b Jean*0248           CALL READ_REC_XY_RS(aim_vegFile,aim_veget,1,myIter,myThid)
                0249          ENDIF
                0250 
f9646b12d5 Jean*0251 C-      endif 1rst iter.
65007c221b Jean*0252         ENDIF
                0253 
f9646b12d5 Jean*0254         IF ( aim_sstFile .NE. ' '  ) THEN
65007c221b Jean*0255           CALL READ_REC_XY_RS(aim_sstFile,aim_sst0,nm0,myIter,myThid)
                0256           CALL READ_REC_XY_RS(aim_sstFile,aim_sst1,nm1,myIter,myThid)
f9646b12d5 Jean*0257         ENDIF
                0258         IF ( aim_lstFile .NE. ' '  ) THEN
65007c221b Jean*0259           CALL READ_REC_XY_RS(aim_lstFile,aim_lst0,nm0,myIter,myThid)
                0260           CALL READ_REC_XY_RS(aim_lstFile,aim_lst1,nm1,myIter,myThid)
f9646b12d5 Jean*0261         ENDIF
                0262         IF ( aim_oiceFile .NE. ' '  ) THEN
65007c221b Jean*0263           CALL READ_REC_XY_RS(aim_oiceFile,aim_oic0,nm0,myIter,myThid)
                0264           CALL READ_REC_XY_RS(aim_oiceFile,aim_oic1,nm1,myIter,myThid)
f9646b12d5 Jean*0265         ENDIF
                0266         IF ( aim_snowFile .NE. ' '  ) THEN
65007c221b Jean*0267           CALL READ_REC_XY_RS(aim_snowFile,aim_snw0,nm0,myIter,myThid)
                0268           CALL READ_REC_XY_RS(aim_snowFile,aim_snw1,nm1,myIter,myThid)
f9646b12d5 Jean*0269         ENDIF
                0270         IF ( aim_swcFile .NE. ' '  ) THEN
65007c221b Jean*0271           CALL READ_REC_XY_RS(aim_swcFile,aim_sw10,nm0,myIter,myThid)
                0272           CALL READ_REC_XY_RS(aim_swcFile,aim_sw11,nm1,myIter,myThid)
                0273           nm2 = nm0 + aim_surfForc_NppCycle
                0274           nm3 = nm1 + aim_surfForc_NppCycle
                0275           CALL READ_REC_XY_RS(aim_swcFile,aim_sw20,nm2,myIter,myThid)
                0276           CALL READ_REC_XY_RS(aim_swcFile,aim_sw21,nm3,myIter,myThid)
f9646b12d5 Jean*0277         ENDIF
5e328a6c4a Davi*0278         IF ( aim_qfxFile .NE. ' '  ) THEN
                0279           CALL READ_REC_XY_RS(aim_qfxFile,aim_qfx0,nm0,myIter,myThid)
                0280           CALL READ_REC_XY_RS(aim_qfxFile,aim_qfx1,nm1,myIter,myThid)
                0281         ENDIF
f9646b12d5 Jean*0282 
65007c221b Jean*0283 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0284 
f9646b12d5 Jean*0285         DO bj = myByLo(myThid), myByHi(myThid)
                0286          DO bi = myBxLo(myThid), myBxHi(myThid)
65007c221b Jean*0287 
f9646b12d5 Jean*0288           IF ( myIter.EQ.nIter0 ) THEN
                0289 C-  Converts surface albedo : from % (input data) to a fraction [0-1}
                0290 c          alb0(i,j) = 0.01*r4inp(i,j)
                0291            DO j=1,sNy
                0292             DO i=1,sNx
                0293              aim_albedo(i,j,bi,bj) = aim_albedo(I,J,bi,bj)/100. _d 0
                0294             ENDDO
                0295            ENDDO
                0296 
                0297 C-  Converts vegetation fraction: from % (input data) to a fraction [0-1]
                0298 c          veg(i,j)=max(0.,0.01*veg(i,j))
65007c221b Jean*0299            DO j=1,sNy
                0300             DO i=1,sNx
f9646b12d5 Jean*0301              aim_veget(i,j,bi,bj) =
                0302      &                 MAX(0. _d 0, aim_veget(i,j,bi,bj)/100. _d 0)
                0303             ENDDO
                0304            ENDDO
                0305 C-      endif 1rst iter.
                0306           ENDIF
                0307 
                0308 C--   Correct for truncation (because of hFacMin) of surface reference
                0309 C      pressure Ro_surf that affects Surf.Temp. :
                0310           DO j=1,sNy
                0311            DO i=1,sNx
65007c221b Jean*0312 c            pfact = (Ro_surf(i,j,bi,bj)/atm_Po)**atm_kappa
                0313              aim_lst0(i,j,bi,bj) = aim_lst0(i,j,bi,bj)
d0a9461855 Jean*0314      &                           * truncSurfP(i,j,bi,bj)
65007c221b Jean*0315              aim_lst1(i,j,bi,bj) = aim_lst1(i,j,bi,bj)
d0a9461855 Jean*0316      &                           * truncSurfP(i,j,bi,bj)
65007c221b Jean*0317            ENDDO
                0318           ENDDO
f9646b12d5 Jean*0319 
                0320 C-     end bi,bj loops
65007c221b Jean*0321          ENDDO
f9646b12d5 Jean*0322         ENDDO
65007c221b Jean*0323 
f9646b12d5 Jean*0324 C--    endif load new data.
65007c221b Jean*0325        ENDIF
                0326 
                0327       ENDIF
                0328 
                0329 #endif /* ALLOW_AIM */
                0330 
f9646b12d5 Jean*0331       RETURN
65007c221b Jean*0332       END
[ 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!