| 1 |
C $Header: /u/gcmpack/models/MITgcmUV/pkg/aim_v23/aim_fields_load.F,v 1.1 2002/12/10 02:35:27 jmc Exp $ |
| 2 |
C $Name: $ |
| 3 |
|
| 4 |
#include "AIM_OPTIONS.h" |
| 5 |
|
| 6 |
CStartOfInterface |
| 7 |
SUBROUTINE AIM_FIELDS_LOAD( |
| 8 |
I myTime, myIter, myThid ) |
| 9 |
C *==========================================================* |
| 10 |
C | SUBROUTINE AIM_FIELDS_LOAD |
| 11 |
C | o Control reading of AIM fields from external source. |
| 12 |
C *==========================================================* |
| 13 |
C | Loads surface boundary condition datasets for AIM. |
| 14 |
C | The routine is called every timetep and periodically |
| 15 |
C | loads a set of external fields. |
| 16 |
C | Monthly climatology files are read either for |
| 17 |
C | a) a direct use (useMMsurfFc): |
| 18 |
C | Albedo, Soil moisture, Surface Temperature |
| 19 |
C | b) time interpolation (useFMsurfBC): |
| 20 |
C | Sea & Land surf. Temp, snow, sea-ice, soil-water (2-lev) |
| 21 |
C | + (1rst.iter) ground albedo, vegetation, land-sea fraction |
| 22 |
C | Most of the work is done by the master the thread while |
| 23 |
C | the other threads spin. |
| 24 |
C *==========================================================* |
| 25 |
IMPLICIT NONE |
| 26 |
|
| 27 |
C === Global variables === |
| 28 |
#include "SIZE.h" |
| 29 |
#include "EEPARAMS.h" |
| 30 |
#include "PARAMS.h" |
| 31 |
#include "GRID.h" |
| 32 |
#include "AIM_PARAMS.h" |
| 33 |
c #include "AIM_GRID.h" |
| 34 |
#include "AIM_FFIELDS.h" |
| 35 |
|
| 36 |
C === Routine arguments === |
| 37 |
C myThid - Thread no. that called this routine. |
| 38 |
C myTime - Simulation time |
| 39 |
C myIter - Simulation timestep number |
| 40 |
INTEGER myThid |
| 41 |
_RL myTime |
| 42 |
INTEGER myIter |
| 43 |
CEndOfInterface |
| 44 |
|
| 45 |
C === Functions === |
| 46 |
LOGICAL DIFFERENT_MULTIPLE |
| 47 |
EXTERNAL DIFFERENT_MULTIPLE |
| 48 |
|
| 49 |
#ifdef ALLOW_AIM |
| 50 |
C === Local variables === |
| 51 |
C bi,bj, i,j - Loop counters |
| 52 |
C tYear - Fraction within year of myTime |
| 53 |
C mnthIndex - Current time in whole months |
| 54 |
C prevMnthIndex |
| 55 |
C fNam - Strings used in constructing file names |
| 56 |
C mnthNam |
| 57 |
C pfact - used to convert Pot.Temp. to in-situ Temp. |
| 58 |
INTEGER bi,bj, i, j |
| 59 |
c _RL pfact |
| 60 |
INTEGER prevMnthIndex |
| 61 |
DATA prevMnthIndex / 0 / |
| 62 |
SAVE prevMnthIndex |
| 63 |
C-- for use with useMMsurfFc: |
| 64 |
_RL tYear, yearLength |
| 65 |
INTEGER mnthIndex |
| 66 |
CHARACTER*(MAX_LEN_FNAM) fNam |
| 67 |
CHARACTER*3 mnthNam(12) |
| 68 |
DATA mnthNam / |
| 69 |
& 'jan', 'feb', 'mar', 'apr', 'may', 'jun', |
| 70 |
& 'jul', 'aug', 'sep', 'oct', 'nov', 'dec' / |
| 71 |
SAVE mnthNam |
| 72 |
C-- for use with useFMsurfBC: |
| 73 |
INTEGER aim_surfForc_NppCycle, nm0, nm1, nm2, nm3 |
| 74 |
_RL aim_surfForc_TimePeriod, aim_surfForc_TransRatio |
| 75 |
_RL t0prd, tNcyc, tmprd, dTprd |
| 76 |
|
| 77 |
IF (aim_useMMsurfFc) THEN |
| 78 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
| 79 |
C-- Use Monthly Mean surface forcing fields: |
| 80 |
|
| 81 |
C- Calculate offset into a year |
| 82 |
c tYear = myTime/(86400.*360.) - |
| 83 |
c & FLOAT(INT(myTime/(86400.*360.))) |
| 84 |
yearLength = 86400.*360. |
| 85 |
tYear = MOD(myTime/yearLength, 1. _d 0) |
| 86 |
mnthIndex = INT(tYear*12.)+1 |
| 87 |
|
| 88 |
IF ( mnthIndex .NE. prevMnthIndex .OR. |
| 89 |
& myIter.EQ.nIter0 ) THEN |
| 90 |
C- New month so load in data |
| 91 |
|
| 92 |
C Prevent loading of new data before everyone has finished with it |
| 93 |
CALL BAR2(myThid) |
| 94 |
|
| 95 |
C Master thread coordinates loading of AIM datasets |
| 96 |
_BEGIN_MASTER( myThid ) |
| 97 |
prevMnthIndex = mnthIndex |
| 98 |
|
| 99 |
C o Albedo ( convert % to fraction ) |
| 100 |
WRITE(fNam,'(A,A,A)' ) 'salb.', |
| 101 |
& mnthNam(mnthIndex), aim_MMsufx(1:aim_MMsufxLength) |
| 102 |
CALL MDSREADFIELD(fNam,readBinaryPrec,'RS',1, |
| 103 |
O aim_albedo, |
| 104 |
I 1,myThid) |
| 105 |
|
| 106 |
C o Surface temperature ( in kelvin ) |
| 107 |
IF (aim_surfPotTemp) THEN |
| 108 |
WRITE(fNam,'(A,A,A)' ) 'stheta.', |
| 109 |
& mnthNam(mnthIndex), aim_MMsufx(1:aim_MMsufxLength) |
| 110 |
ELSE |
| 111 |
WRITE(fNam,'(A,A,A)' ) 'sTemp.', |
| 112 |
& mnthNam(mnthIndex), aim_MMsufx(1:aim_MMsufxLength) |
| 113 |
ENDIF |
| 114 |
CALL MDSREADFIELD(fNam,readBinaryPrec,'RS',1, |
| 115 |
O aim_surftemp, |
| 116 |
I 1,myThid) |
| 117 |
|
| 118 |
C o Soil moisture |
| 119 |
WRITE(fNam,'(A,A,A)' ) 'smoist.', |
| 120 |
& mnthNam(mnthIndex), aim_MMsufx(1:aim_MMsufxLength) |
| 121 |
CALL MDSREADFIELD(fNam,readBinaryPrec,'RS',1, |
| 122 |
O aim_soilWater, |
| 123 |
I 1,myThid) |
| 124 |
|
| 125 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
| 126 |
|
| 127 |
C-- Converts fields for direct use in Atmos. Physics routine. |
| 128 |
C better here rather than in "aim_do_atmos" since: |
| 129 |
C a) change together conversion factor and input file name. |
| 130 |
C b) conversion applied only 1 time / month ; |
| 131 |
C c) easy to check here (variable in common). |
| 132 |
|
| 133 |
DO bj=1,nSy |
| 134 |
DO bi=1,nSx |
| 135 |
|
| 136 |
C- Converts surface albedo : input data is in % 0-100 |
| 137 |
C and Franco s package needs a fraction between 0-1 |
| 138 |
DO j=1,sNy |
| 139 |
DO i=1,sNx |
| 140 |
aim_albedo(I,J,bi,bj) = aim_albedo(I,J,bi,bj)/100. |
| 141 |
ENDDO |
| 142 |
ENDDO |
| 143 |
|
| 144 |
C- Converts soil moisture (case input is in cm in bucket of depth 20cm.) |
| 145 |
c DO j=1,sNy |
| 146 |
c DO i=1,sNx |
| 147 |
c aim_soilWater(I,J,bi,bj) = aim_soilWater(I,J,bi,bj) |
| 148 |
c & /20. |
| 149 |
c ENDDO |
| 150 |
c ENDDO |
| 151 |
|
| 152 |
C-- Correct for truncation (because of hFacMin) of surface reference |
| 153 |
C pressure Ro_surf that affects Surf.Temp. : |
| 154 |
DO j=1,sNy |
| 155 |
DO i=1,sNx |
| 156 |
c pfact = (Ro_surf(i,j,bi,bj)/atm_Po)**atm_kappa |
| 157 |
aim_surftemp(i,j,bi,bj) = aim_surftemp(i,j,bi,bj) |
| 158 |
& * truncSurfP(i,j,bi,bj) |
| 159 |
ENDDO |
| 160 |
ENDDO |
| 161 |
|
| 162 |
C-- end bi,bj loops |
| 163 |
ENDDO |
| 164 |
ENDDO |
| 165 |
|
| 166 |
IF (myIter.EQ.nIter0) |
| 167 |
& CALL WRITE_FLD_XY_RL('aim_Tsurf',' ',aim_surfTemp,0,myThid) |
| 168 |
|
| 169 |
_END_MASTER( myThid ) |
| 170 |
|
| 171 |
C Stop anyone leaving until all data is read |
| 172 |
CALL BAR2(myThid) |
| 173 |
|
| 174 |
C- endif New month - load in data |
| 175 |
ENDIF |
| 176 |
|
| 177 |
ELSEIF (aim_useFMsurfBC) THEN |
| 178 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
| 179 |
C-- Use Franco Molteni surface BC: |
| 180 |
C take part of S/R INFORC + part of S/R FORDATE (albedo) |
| 181 |
C of the F.Molteni SPEEDY code (ver23) |
| 182 |
|
| 183 |
IF ( myIter.EQ.nIter0 ) THEN |
| 184 |
DO bj = myByLo(myThid), myByHi(myThid) |
| 185 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
| 186 |
DO j=1-Oly,sNy+Oly |
| 187 |
DO i=1-Olx,sNx+Olx |
| 188 |
aim_landFr(i,j,bi,bj)= 0. |
| 189 |
aim_albedo(i,j,bi,bj)= 0. |
| 190 |
aim_veget(i,j,bi,bj) = 0. |
| 191 |
aim_sst0(i,j,bi,bj) =300. |
| 192 |
aim_lst0(i,j,bi,bj) =300. |
| 193 |
aim_oic0(i,j,bi,bj) = 0. |
| 194 |
aim_snw0(i,j,bi,bj) = 0. |
| 195 |
aim_sw10(i,j,bi,bj) = 0. |
| 196 |
aim_sw20(i,j,bi,bj) = 0. |
| 197 |
aim_sst1(i,j,bi,bj) =300. |
| 198 |
aim_lst1(i,j,bi,bj) =300. |
| 199 |
aim_oic1(i,j,bi,bj) = 0. |
| 200 |
aim_snw1(i,j,bi,bj) = 0. |
| 201 |
aim_sw11(i,j,bi,bj) = 0. |
| 202 |
aim_sw21(i,j,bi,bj) = 0. |
| 203 |
ENDDO |
| 204 |
ENDDO |
| 205 |
ENDDO |
| 206 |
ENDDO |
| 207 |
ENDIF |
| 208 |
|
| 209 |
C- Length (s) of one time period: |
| 210 |
aim_surfForc_TimePeriod = 30.*86400. |
| 211 |
C- Number of time period per Cycle: |
| 212 |
aim_surfForc_NppCycle = 12 |
| 213 |
C- define how fast the (linear) transition is from one month to the next |
| 214 |
C = 1 -> linear between 2 midle month |
| 215 |
C > TimePeriod/deltaT -> jump from one month to the next one |
| 216 |
aim_surfForc_TransRatio = 1. |
| 217 |
|
| 218 |
t0prd = myTime / aim_surfForc_TimePeriod |
| 219 |
tNcyc = aim_surfForc_NppCycle |
| 220 |
tmprd = t0prd - 0.5 _d 0 + tNcyc |
| 221 |
tmprd = MOD(tmprd,tNcyc) |
| 222 |
C- indices of previous month and next month: |
| 223 |
nm0 = 1 + INT(tmprd) |
| 224 |
nm1 = 1 + MOD(nm0,aim_surfForc_NppCycle) |
| 225 |
C- interpolation weight: |
| 226 |
dTprd = tmprd - (nm0 - 1) |
| 227 |
aim_sWght1 = 0.5 _d 0+(dTprd-0.5 _d 0)*aim_surfForc_TransRatio |
| 228 |
aim_sWght1 = MAX( 0. _d 0, MIN(1. _d 0, aim_sWght1) ) |
| 229 |
aim_sWght0 = 1. _d 0 - aim_sWght1 |
| 230 |
|
| 231 |
IF (myIter.EQ.nIter0 .OR. nm0.NE.prevMnthIndex) THEN |
| 232 |
C- Load new data: |
| 233 |
|
| 234 |
C Prevent loading of new data before everyone has finished with it |
| 235 |
CALL BAR2(myThid) |
| 236 |
|
| 237 |
C Master thread coordinates loading of AIM datasets |
| 238 |
_BEGIN_MASTER( myThid ) |
| 239 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
| 240 |
prevMnthIndex = nm0 |
| 241 |
|
| 242 |
IF ( myIter.EQ.nIter0 ) THEN |
| 243 |
C-- Load Fixed Forcing only at the 1rst iter: |
| 244 |
|
| 245 |
IF ( aim_LandFile .NE. ' ' ) THEN |
| 246 |
CALL READ_REC_XY_RS(aim_LandFile,aim_landFr,1,myIter,myThid) |
| 247 |
ENDIF |
| 248 |
IF ( aim_albFile .NE. ' ' ) THEN |
| 249 |
CALL READ_REC_XY_RS(aim_albFile,aim_albedo, 1,myIter,myThid) |
| 250 |
ENDIF |
| 251 |
c alb0(i,j) = 0.01*r4inp(i,j) |
| 252 |
IF ( aim_vegFile .NE. ' ' ) THEN |
| 253 |
CALL READ_REC_XY_RS(aim_vegFile,aim_veget,1,myIter,myThid) |
| 254 |
ENDIF |
| 255 |
|
| 256 |
DO bj=1,nSy |
| 257 |
DO bi=1,nSx |
| 258 |
|
| 259 |
C- Converts surface albedo : from % (input data) to a fraction [0-1} |
| 260 |
c alb0(i,j) = 0.01*r4inp(i,j) |
| 261 |
DO j=1,sNy |
| 262 |
DO i=1,sNx |
| 263 |
aim_albedo(i,j,bi,bj) = aim_albedo(I,J,bi,bj)/100. _d 0 |
| 264 |
ENDDO |
| 265 |
ENDDO |
| 266 |
|
| 267 |
C- Converts vegetation fraction: from % (input data) to a fraction [0-1] |
| 268 |
c veg(i,j)=max(0.,0.01*veg(i,j)) |
| 269 |
DO j=1,sNy |
| 270 |
DO i=1,sNx |
| 271 |
aim_veget(i,j,bi,bj) = |
| 272 |
& MAX(0. _d 0, aim_veget(i,j,bi,bj)/100. _d 0) |
| 273 |
ENDDO |
| 274 |
ENDDO |
| 275 |
|
| 276 |
ENDDO |
| 277 |
ENDDO |
| 278 |
|
| 279 |
C-- endif 1rst iter. |
| 280 |
ENDIF |
| 281 |
|
| 282 |
IF ( aim_sstFile .NE. ' ' ) THEN |
| 283 |
CALL READ_REC_XY_RS(aim_sstFile,aim_sst0,nm0,myIter,myThid) |
| 284 |
CALL READ_REC_XY_RS(aim_sstFile,aim_sst1,nm1,myIter,myThid) |
| 285 |
ENDIF |
| 286 |
IF ( aim_lstFile .NE. ' ' ) THEN |
| 287 |
CALL READ_REC_XY_RS(aim_lstFile,aim_lst0,nm0,myIter,myThid) |
| 288 |
CALL READ_REC_XY_RS(aim_lstFile,aim_lst1,nm1,myIter,myThid) |
| 289 |
ENDIF |
| 290 |
IF ( aim_oiceFile .NE. ' ' ) THEN |
| 291 |
CALL READ_REC_XY_RS(aim_oiceFile,aim_oic0,nm0,myIter,myThid) |
| 292 |
CALL READ_REC_XY_RS(aim_oiceFile,aim_oic1,nm1,myIter,myThid) |
| 293 |
ENDIF |
| 294 |
IF ( aim_snowFile .NE. ' ' ) THEN |
| 295 |
CALL READ_REC_XY_RS(aim_snowFile,aim_snw0,nm0,myIter,myThid) |
| 296 |
CALL READ_REC_XY_RS(aim_snowFile,aim_snw1,nm1,myIter,myThid) |
| 297 |
ENDIF |
| 298 |
IF ( aim_swcFile .NE. ' ' ) THEN |
| 299 |
CALL READ_REC_XY_RS(aim_swcFile,aim_sw10,nm0,myIter,myThid) |
| 300 |
CALL READ_REC_XY_RS(aim_swcFile,aim_sw11,nm1,myIter,myThid) |
| 301 |
nm2 = nm0 + aim_surfForc_NppCycle |
| 302 |
nm3 = nm1 + aim_surfForc_NppCycle |
| 303 |
CALL READ_REC_XY_RS(aim_swcFile,aim_sw20,nm2,myIter,myThid) |
| 304 |
CALL READ_REC_XY_RS(aim_swcFile,aim_sw21,nm3,myIter,myThid) |
| 305 |
ENDIF |
| 306 |
|
| 307 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
| 308 |
_END_MASTER( myThid ) |
| 309 |
|
| 310 |
C Stop anyone leaving until all data is read |
| 311 |
CALL BAR2(myThid) |
| 312 |
|
| 313 |
C-- Correct for truncation (because of hFacMin) of surface reference |
| 314 |
C pressure Ro_surf that affects Surf.Temp. : |
| 315 |
DO bj = myByLo(myThid), myByHi(myThid) |
| 316 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
| 317 |
DO j=1,sNy |
| 318 |
DO i=1,sNx |
| 319 |
c pfact = (Ro_surf(i,j,bi,bj)/atm_Po)**atm_kappa |
| 320 |
aim_lst0(i,j,bi,bj) = aim_lst0(i,j,bi,bj) |
| 321 |
& * truncSurfP(i,j,bi,bj) |
| 322 |
aim_lst1(i,j,bi,bj) = aim_lst1(i,j,bi,bj) |
| 323 |
& * truncSurfP(i,j,bi,bj) |
| 324 |
ENDDO |
| 325 |
ENDDO |
| 326 |
ENDDO |
| 327 |
ENDDO |
| 328 |
|
| 329 |
C- endif load new data. |
| 330 |
ENDIF |
| 331 |
|
| 332 |
ENDIF |
| 333 |
|
| 334 |
#endif /* ALLOW_AIM */ |
| 335 |
|
| 336 |
RETURN |
| 337 |
END |
Parent Directory
| 
Revision Log
| 
Revision Graph