File indexing completed on 2021-11-06 05:16:52 UTC
view on githubraw file Latest commit 75c5b64b on 2021-11-03 02:00:03 UTC
d676f916b2 Jean*0001 #include "AIM_OPTIONS.h"
0002
cdcb187d4c Jean*0003
0004
0005
067df0e288 Jean*0006 SUBROUTINE AIM_DO_PHYSICS( myTime, myIter, myThid )
26eee352b3 Jean*0007
cdcb187d4c Jean*0008
d676f916b2 Jean*0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
cdcb187d4c Jean*0020
0021
0022
d676f916b2 Jean*0023 IMPLICIT NONE
0024
0025
0026
0027 #include "AIM_SIZE.h"
0028
0029
0030 #include "EEPARAMS.h"
0031 #include "PARAMS.h"
0032 #include "DYNVARS.h"
0033 #include "GRID.h"
0034 #include "SURFACE.h"
0035
0036
a27dd2281d Jean*0037 #include "AIM_PARAMS.h"
d676f916b2 Jean*0038 #include "AIM_FFIELDS.h"
0039 #include "AIM_GRID.h"
0040 #include "com_physvar.h"
0041 #include "com_forcing.h"
fd89ae98c4 Jean*0042 #include "AIM2DYN.h"
d676f916b2 Jean*0043
cdcb187d4c Jean*0044
d676f916b2 Jean*0045
31206edf1f Jean*0046
0047
0048
0049 _RL myTime
0050 INTEGER myIter
0051 INTEGER myThid
cdcb187d4c Jean*0052
d676f916b2 Jean*0053
0054 #ifdef ALLOW_AIM
2a80e4d00e Jean*0055
0056
0057
0058
0059
0060
0061 _RL phi0 (NGP)
0062
d676f916b2 Jean*0063
067df0e288 Jean*0064
d0a9461855 Jean*0065
0066
0067
0068
0069
7d37b6de57 Jean*0070
067df0e288 Jean*0071 INTEGER bi,bj
65d8b97200 Jean*0072 INTEGER i,j,k,I2
d676f916b2 Jean*0073 _RL tYear, yearLength
d0a9461855 Jean*0074 _RL aim_sWght0, aim_sWght1
cdcb187d4c Jean*0075 _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
7d37b6de57 Jean*0076 _RL snowPr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
fdb98eff0e Jean*0077 #ifdef ALLOW_THSICE
0078 _RL qPrcRn(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0079 #endif
d676f916b2 Jean*0080
2a80e4d00e Jean*0081
0082
870deba1f6 Davi*0083 #ifdef ALLOW_AIM_CO2
0084 CALL AIM_DO_CO2( myTime, myIter, myThid )
0085 #endif
0086
067df0e288 Jean*0087
0088 DO bj=myByLo(myThid),myByHi(myThid)
0089 DO bi=myBxLo(myThid),myBxHi(myThid)
0090
d676f916b2 Jean*0091
0092
fd89ae98c4 Jean*0093 DO j = 1-OLy, sNy+OLy
0094 DO i = 1-OLx, sNx+OLx
0095 k = kSurfC(i,j,bi,bj)
0096 IF (k.LE.Nr)
d676f916b2 Jean*0097 & salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
0098 & + salt(i,j,Nr,bi,bj)*drF(Nr)*recip_drF(k)
0099 & *hFacC(i,j,Nr,bi,bj)*recip_hFacC(i,j,k,bi,bj)
fd89ae98c4 Jean*0100 salt(i,j,Nr,bi,bj) = 0.
0101 ENDDO
0102 ENDDO
d676f916b2 Jean*0103
0104
0105
0106
fd89ae98c4 Jean*0107 yearLength = 86400.*360.
0108 tYear = MOD(myTime/yearLength, 1. _d 0)
d676f916b2 Jean*0109
65007c221b Jean*0110
0111
0112
fd89ae98c4 Jean*0113 CALL AIM_SURF_BC(
0114 U tYear,
0115 O aim_sWght0, aim_sWght1,
0116 I bi, bj, myTime, myIter, myThid )
d676f916b2 Jean*0117
0118
fd89ae98c4 Jean*0119 DO j=1,sNy
0120 DO i=1,sNx
0121 I2 = i+(j-1)*sNx
0122 PHI0(I2) = gravity*topoZ(i,j,bi,bj)
0123 ENDDO
0124 ENDDO
d676f916b2 Jean*0125
0126
0127
0128
0129
0130
0131 CALL SFLSET (PHI0, fOrogr(1,myThid), bi,bj,myThid)
0132
0133
0134
0135
0136
0137
fd89ae98c4 Jean*0138 CALL PHY_DRIVER( tYear, useDiagnostics,
0139 I bi, bj, myTime, myIter, myThid )
d676f916b2 Jean*0140
fd89ae98c4 Jean*0141 CALL AIM_AIM2DYN( bi, bj, myTime, myIter, myThid )
d676f916b2 Jean*0142
a27dd2281d Jean*0143 #ifdef ALLOW_LAND
fd89ae98c4 Jean*0144 IF (useLand) THEN
a27dd2281d Jean*0145
fd89ae98c4 Jean*0146 CALL AIM_AIM2LAND( aim_landFr, bi, bj,
0147 I myTime, myIter, myThid )
a27dd2281d Jean*0148
0149
fd89ae98c4 Jean*0150 CALL LAND_STEPFWD( aim_landFr, bi, bj,
0151 I myTime, myIter, myThid )
a27dd2281d Jean*0152
0153
fd89ae98c4 Jean*0154 CALL LAND_DO_DIAGS( aim_landFr, bi, bj,
0155 I myTime, myIter, myThid )
a27dd2281d Jean*0156
fd89ae98c4 Jean*0157 ENDIF
a27dd2281d Jean*0158 #endif /* ALLOW_LAND */
0159
65d8b97200 Jean*0160
3dd105254f Jean*0161
b08caedd9d Jean*0162 CALL AIM_AIM2SIOCE( aim_landFr, fmask1(1,3,myThid),
7d37b6de57 Jean*0163 O prcAtm, snowPr,
3dd105254f Jean*0164 I bi, bj, myTime, myIter, myThid )
0165
cdcb187d4c Jean*0166 #ifdef ALLOW_THSICE
fd89ae98c4 Jean*0167 IF ( useThSIce ) THEN
cdcb187d4c Jean*0168
fdb98eff0e Jean*0169 DO j = 1-OLy, sNy+OLy
0170 DO i = 1-OLx, sNx+OLx
0171 qPrcRn(i,j) = 0.
0172 ENDDO
0173 ENDDO
fd89ae98c4 Jean*0174 CALL THSICE_STEP_FWD( bi, bj, 1, sNx, 1, sNy,
7d37b6de57 Jean*0175 I prcAtm, snowPr, qPrcRn,
fd89ae98c4 Jean*0176 I myTime, myIter, myThid )
0177 ENDIF
0178 #endif /* ALLOW_THSICE */
cdcb187d4c Jean*0179
fd89ae98c4 Jean*0180
0181 CALL AIM_DIAGNOSTICS( bi, bj, myTime, myIter, myThid )
cdcb187d4c Jean*0182
fd89ae98c4 Jean*0183
0184 ENDDO
0185 ENDDO
cdcb187d4c Jean*0186
fd89ae98c4 Jean*0187 #ifdef ALLOW_THSICE
0188 IF ( useThSIce ) THEN
0189
0190 CALL THSICE_DO_EXCH( myThid )
0191
0192 CALL THSICE_DO_ADVECT(
0193 I 0, 0, myTime, myIter, myThid )
3559edb19a Jean*0194 DO bj=myByLo(myThid),myByHi(myThid)
0195 DO bi=myBxLo(myThid),myBxHi(myThid)
fd89ae98c4 Jean*0196
0197 CALL THSICE_SLAB_OCEAN(
0198 I aim_sWght0, aim_sWght1,
0199 O dTsurf(1,2,myThid),
0200 I bi, bj, myTime, myIter, myThid )
3559edb19a Jean*0201 ENDDO
0202 ENDDO
0203 ENDIF
0204 #endif /* ALLOW_THSICE */
fd89ae98c4 Jean*0205
0206
0207 _EXCH_XY_RL( aim_drag, myThid )
0208
0209 #ifdef COMPONENT_MODULE
0210 IF ( useCoupler ) THEN
3559edb19a Jean*0211 CALL ATM_STORE_MY_DATA( myTime, myIter, myThid )
fd89ae98c4 Jean*0212 ENDIF
0213 #endif /* COMPONENT_MODULE */
0214
d676f916b2 Jean*0215 #endif /* ALLOW_AIM */
0216
0217 RETURN
0218 END