Changeset 4246 for dynamico_lmdz
- Timestamp:
- Jun 24, 2020, 2:13:23 PM (4 years ago)
- Location:
- dynamico_lmdz/simple_physics
- Files:
-
- 3 added
- 6 edited
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
dynamico_lmdz/simple_physics/config/DYNAMICO/TEST/run.def
r4245 r4246 41 41 diurnal=.TRUE. 42 42 43 planet_rad=6.37122e6 44 mugaz=28.97 45 43 46 #---------------- Run --------------- 44 47 run_length=8640000 -
dynamico_lmdz/simple_physics/phyparam/Makefile
r4236 r4246 19 19 bash/extract_cython.sh 20 20 cd python ; rm -rf build *.c ; python setup.py build_ext --inplace 21 cd python ; python -c 'import phyparam as phys ; phys.setup(100.); phys.alloc(30,100) ; phys.coldstart(30, 100.)'22 21 obj : 23 22 @rm -rf obj include lib xml tmp *~ */*~ -
dynamico_lmdz/simple_physics/phyparam/physics/iniphyparam_mod.F90
r4245 r4246 10 10 CONTAINS 11 11 12 SUBROUTINE read_params( ptimestep) BIND(C, name='phyparam_setup')13 !$cython header void phyparam_setup( double);14 !$cython wrapper def setup( timestep) : phy.phyparam_setup(timestep)12 SUBROUTINE read_params() BIND(C, name='phyparam_setup') 13 !$cython header void phyparam_setup(); 14 !$cython wrapper def setup() : phy.phyparam_setup() 15 15 USE read_param_mod 16 16 USE phys_const, ONLY : planet_rad,g,r,cpp,rcp,dtphys,unjours,mugaz … … 18 18 USE planet, ONLY : coefir, coefvis 19 19 USE turbulence, ONLY : lmixmin, emin_turb 20 USE s urface20 USE soil_mod 21 21 USE callkeys 22 REAL, INTENT(IN), VALUE :: ptimestep23 22 24 23 CALL read_param('planet_rad',6.4e6 ,planet_rad,'planet_rad') … … 59 58 CALL read_param('period_sort', 1., period_sort, 'period sorties en jour') 60 59 60 END SUBROUTINE read_params 61 62 SUBROUTINE iniphyparam(ptimestep, punjours, prad, pg, pr, pcpp) 63 USE comgeomfi, ONLY : nsoilmx 64 USE soil_mod, ONLY : init_soil 65 USE phys_const, ONLY : planet_rad,g,r,cpp,rcp,dtphys,unjours 66 USE callkeys 67 REAL, INTENT(IN) :: ptimestep, punjours, prad, pg, pr, pcpp 68 69 CALL read_params 61 70 ! choice of the frequency of the computation of radiations 62 71 IF(diurnal) THEN … … 66 75 ENDIF 67 76 iradia=1 77 dtphys=ptimestep 68 78 69 dtphys=ptimestep 70 END SUBROUTINE read_params 71 72 SUBROUTINE iniphyparam(ptimestep, punjours, prad, pg, pr, pcpp) 73 USE comgeomfi, ONLY : nsoilmx 74 USE surface, ONLY : init_soil 75 USE phys_const, ONLY : planet_rad,g,r,cpp,rcp,dtphys,unjours 76 USE callkeys 77 REAL, INTENT(IN) :: ptimestep, punjours, prad, pg, pr, pcpp 78 79 CALL read_params(ptimestep) 80 CALL check_mismatch('unjours', punjours, unjours) 81 CALL check_mismatch('rad', prad, planet_rad) 82 CALL check_mismatch('g', pg, g) 83 CALL check_mismatch('R', pr, r) 84 CALL check_mismatch('cpp', pcpp, cpp) 79 CALL check_mismatch('day lenght (s)', punjours, unjours) 80 CALL check_mismatch('planetary radius (km)', prad/1000., planet_rad/1000.) 81 CALL check_mismatch('gravity', pg, g) 82 CALL check_mismatch('specific R', pr, r) 83 CALL check_mismatch('specific heat capacity', pcpp, cpp) 85 84 LOG_WARN('iniphyparam') 86 85 -
dynamico_lmdz/simple_physics/phyparam/physics/phyparam_mod.F90
r4245 r4246 24 24 & pdu,pdv,pdt,pdpsrf) BIND(C, name='phyparam_phyparam') 25 25 USE phys_const, ONLY : g, rcp, r, unjours 26 USE surface, ONLY : soil_forward, soil_backward 27 USE surface, ONLY : z0, inertie, emissiv, albedo ! precomputed 28 USE surface, ONLY : tsurf, tsoil ! state variables 29 ! USE surface, ONLY : capcal, fluxgrd, zc, zd ! should be temporaries 26 USE soil_mod, ONLY : soil_forward, soil_backward 27 USE soil_mod, ONLY : z0, inertie, emissiv, albedo ! precomputed 28 USE soil_mod, ONLY : tsurf, tsoil ! state variables 30 29 USE turbulence, ONLY : vdif 31 30 USE convection, ONLY : convadj … … 77 76 & zd(ngrid, nsoilmx), & 78 77 & fluxgrd(ngrid), & ! heat flux from deep soil 79 & capcal(ngrid) 78 & capcal(ngrid), & ! effective heat capacity of soil 80 79 & zdufr(ngrid,nlayer), & ! partial tendencies for zonal velocity, 81 80 & zdvfr(ngrid,nlayer), & ! meridional velocity, … … 84 83 & zdtsrf(ngrid), & ! total tendency of surface temperature 85 84 & zflubid(ngrid), & ! radiative + deep soil fluxes 86 & zpmer(ngrid) , &! sea-level pressure85 & zpmer(ngrid) ! sea-level pressure 87 86 REAL zdum1(ngrid,nlayer) 88 87 REAL zdum2(ngrid,nlayer) … … 118 117 CALL alloc(ngrid, nlayer) 119 118 CALL precompute 120 CALL coldstart(ngrid , ptimestep)119 CALL coldstart(ngrid) 121 120 ENDIF 122 121 … … 178 177 IF (callsoil) THEN 179 178 CALL soil_forward(ngrid,nsoilmx, ptimestep, inertie, tsurf, tsoil, & 180 & zc, zd, capcal, fluxgrd)181 182 ! CALL soil_new(ngrid,nsoilmx,ptimestep,inertie, &183 ! tsurf, tsoil, capcal,fluxgrd)184 ! CALL soil(ngrid,nsoilmx,.false.,inertie, &185 ! & ptimestep,tsurf,tsoil,capcal,fluxgrd)179 & zc, zd, capcal, fluxgrd) 180 181 ! CALL soil_new(ngrid,nsoilmx,ptimestep,inertie, & 182 ! tsurf, tsoil, capcal,fluxgrd) 183 ! CALL soil(ngrid,nsoilmx,.false.,inertie, & 184 ! & ptimestep,tsurf,tsoil,capcal,fluxgrd) 186 185 ELSE 187 186 capcal(:) = capcal_nosoil 188 187 fluxgrd(:) = 0. 189 END IF188 END IF 190 189 191 190 IF(lverbose) THEN … … 193 192 WRITELOG(*,*) capcal(igout), fluxgrd(igout), tsurf(igout) 194 193 LOG_DBG('phyparam') 195 END IF194 END IF 196 195 197 196 !----------------------------------------------------------------------- … … 345 344 !$cython wrapper def alloc(ngrid, nlayer) : phy.phyparam_alloc(ngrid, nlayer) 346 345 USE astronomy, ONLY : iniorbit 347 USE s urface346 USE soil_mod 348 347 INTEGER, INTENT(IN), VALUE :: ngrid, nlayer 349 348 ! allocate precomputed arrays … … 353 352 ALLOCATE(tsurf(ngrid)) 354 353 ALLOCATE(tsoil(ngrid,nsoilmx)) 355 IF(.FALSE.) THEN ! arrays below are now local temporaries in phyparam356 ALLOCATE(capcal(ngrid),fluxgrd(ngrid))357 ALLOCATE(zc(ngrid,nsoilmx),zd(ngrid,nsoilmx))358 END IF359 354 CALL iniorbit 360 355 END SUBROUTINE alloc … … 364 359 !$cython wrapper def precompute() : phy.phyparam_precompute() 365 360 ! precompute time-independent arrays 366 USE s urface361 USE soil_mod 367 362 rnatur(:) = 1. 368 363 inertie(:) = (1.-rnatur(:))*I_mer+rnatur(:)*I_ter … … 372 367 END SUBROUTINE precompute 373 368 374 SUBROUTINE coldstart(ngrid , ptimestep) BIND(C, name='phyparam_coldstart')375 !$cython header void phyparam_coldstart(int , double);376 !$cython wrapper def coldstart (ngrid , timestep): phy.phyparam_coldstart(ngrid, timestep)369 SUBROUTINE coldstart(ngrid) BIND(C, name='phyparam_coldstart') 370 !$cython header void phyparam_coldstart(int); 371 !$cython wrapper def coldstart (ngrid): phy.phyparam_coldstart(ngrid) 377 372 ! create internal state to start a run without a restart file 378 USE s urface373 USE soil_mod, ONLY : tsurf, tsoil 379 374 INTEGER, INTENT(IN), VALUE :: ngrid 380 REAL, INTENT(IN), VALUE :: ptimestep381 375 tsurf(:) = tsoil_init 382 376 tsoil(:,:) = tsoil_init 383 377 icount=0 384 IF(callsoil) THEN 385 IF(.FALSE.) THEN 386 ! init_soil is now called by iniphyparam 387 ! initializes zc, zd, capcal, fluxgrd 388 CALL soil(ngrid,nsoilmx,.TRUE.,inertie, & 389 & ptimestep,tsurf,tsoil,capcal,fluxgrd) 390 END IF 391 IF(.FALSE.) THEN ! soil_forward is now called by phyparam 392 CALL soil_forward(ngrid, nsoilmx, ptimestep, inertie, tsurf, tsoil, & 393 & zc, zd, capcal, fluxgrd) 394 END IF 395 ELSE 378 IF(.NOT. callsoil) THEN 396 379 WRITELOG(*,*) 'WARNING!!! Thermal conduction in the soil turned off' 397 380 LOG_WARN('coldstart') 398 capcal(:) = capcal_nosoil399 fluxgrd(:) = 0.400 381 ENDIF 401 382 END SUBROUTINE coldstart -
dynamico_lmdz/simple_physics/phyparam/physics/radiative_mod.F90
r4244 r4246 21 21 USE astronomy, ONLY : orbite, solarlong 22 22 USE solar, ONLY : solang, zenang, mucorr 23 USE s urface,ONLY : albedo, emissiv, tsurf23 USE soil_mod, ONLY : albedo, emissiv, tsurf 24 24 USE radiative_sw, ONLY : sw 25 25 USE radiative_lw, ONLY : lw -
dynamico_lmdz/simple_physics/phyparam/physics/soil_mod.F90
r4245 r4246 1 MODULE s urface1 MODULE soil_mod 2 2 3 3 #include "use_logging.h" … … 23 23 REAL, ALLOCATABLE :: tsurf(:), tsoil(:,:) 24 24 !$OMP THREADPRIVATE(tsurf, tsoil) 25 ! variables below should be temporary arrays, not persistent26 REAL, ALLOCATABLE :: zc(:,:),zd(:,:), capcal(:), fluxgrd(:)27 !$OMP THREADPRIVATE(zc,zd, capcal, fluxgrd)28 25 29 PUBLIC :: init_soil, & 30 soil, soil_new, soil_forward, soil_backward, & 31 zc, zd, & 26 PUBLIC :: init_soil, soil_forward, soil_backward, & 32 27 rnatur, albedo, emissiv, z0, inertie, & 33 tsurf, tsoil , capcal, fluxgrd28 tsurf, tsoil 34 29 35 30 CONTAINS … … 86 81 END SUBROUTINE init_soil 87 82 83 !======================================================================= 84 ! 85 ! Auteur: Frederic Hourdin 30/01/92 86 ! ------- 87 ! 88 ! objet: computation of : the soil temperature evolution 89 ! ------ the surfacic heat capacity "Capcal" 90 ! the surface conduction flux pcapcal 91 ! 92 ! 93 ! Method: implicit time integration 94 ! ------- 95 ! Consecutive ground temperatures are related by: 96 ! T(k+1) = C(k) + D(k)*T(k) (1) 97 ! the coefficients C and D are computed at the t-dt time-step. 98 ! Routine structure: 99 ! 1)new temperatures are computed using (1) 100 ! 2)C and D coefficients are computed from the new temperature 101 ! profile for the t+dt time-step 102 ! 3)the coefficients A and B are computed where the diffusive 103 ! fluxes at the t+dt time-step is given by 104 ! Fdiff = A + B Ts(t+dt) 105 ! or Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt 106 ! with F0 = A + B (Ts(t)) 107 ! Capcal = B*dt 108 ! 109 88 110 PURE SUBROUTINE soil_backward(ngrid,nsoil, zc,zd, ptsrf,ptsoil) 89 111 INTEGER, INTENT(IN) :: ngrid, nsoil ! number of columns, of soil layers … … 97 119 ! coefficient computed during the forward sweep 98 120 ! ----------------------------------------------- 99 121 100 122 ! surface temperature => temperature in first soil layer 101 123 DO ig=1,ngrid … … 103 125 & (lambda*(1.-zd(ig,1))+1.) 104 126 ENDDO 105 127 106 128 ! other temperatures 107 129 DO jk=1,nsoil-1 … … 129 151 ! Computation of the Cgrd and Dgrd coefficients the backward sweep : 130 152 ! --------------------------------------------------------------- 131 153 132 154 DO jk=1,nsoil 133 155 zdz2(jk)=dz2(jk)/ptimestep 134 156 ENDDO 135 157 136 158 DO ig=1,ngrid 137 159 z1=zdz2(nsoil)+dz1(nsoil-1) … … 139 161 zd(ig,nsoil-1)=dz1(nsoil-1)/z1 140 162 ENDDO 141 163 142 164 DO jk=nsoil-1,2,-1 143 165 DO ig=1,ngrid … … 148 170 ENDDO 149 171 ENDDO 150 172 151 173 !----------------------------------------------------------------------- 152 174 ! computation of the surface diffusive flux from ground and 153 175 ! calorific capacity of the ground: 154 176 ! --------------------------------- 155 177 156 178 DO ig=1,ngrid 157 179 pfluxgrd(ig)=ptherm_i(ig)*dz1(1)* & … … 166 188 END SUBROUTINE soil_forward 167 189 168 SUBROUTINE soil_new(ngrid,nsoil,ptimestep,ptherm_i, ptsrf,ptsoil, pcapcal,pfluxgrd) 169 INTEGER, INTENT(IN) :: ngrid, nsoil ! number of columns, of soil layers 170 REAL, INTENT(IN) :: ptimestep, & ! time step 171 & ptherm_i(ngrid) ! thermal inertia ?? 172 REAL, INTENT(INOUT) :: ptsrf(ngrid), & ! surface temperature 173 & ptsoil(ngrid,nsoil) ! soil temperature 174 REAL, INTENT(OUT) :: pcapcal(ngrid), & ! effective calorific capacity 175 & pfluxgrd(ngrid) ! conductive heat flux at the ground 176 CALL soil_backward(ngrid,nsoil, zc,zd, ptsrf,ptsoil) 177 CALL soil_forward(ngrid, nsoil, ptimestep, ptherm_i, ptsrf, ptsoil, & 178 & zc, zd, pcapcal, pfluxgrd) 179 END SUBROUTINE soil_new 180 181 SUBROUTINE soil(ngrid,nsoil,firstcall,ptherm_i, & 182 & ptimestep,ptsrf,ptsoil, & 183 & pcapcal,pfluxgrd) 184 185 !======================================================================= 186 ! 187 ! Auteur: Frederic Hourdin 30/01/92 188 ! ------- 189 ! 190 ! objet: computation of : the soil temperature evolution 191 ! ------ the surfacic heat capacity "Capcal" 192 ! the surface conduction flux pcapcal 193 ! 194 ! 195 ! Method: implicit time integration 196 ! ------- 197 ! Consecutive ground temperatures are related by: 198 ! T(k+1) = C(k) + D(k)*T(k) (1) 199 ! the coefficients C and D are computed at the t-dt time-step. 200 ! Routine structure: 201 ! 1)new temperatures are computed using (1) 202 ! 2)C and D coefficients are computed from the new temperature 203 ! profile for the t+dt time-step 204 ! 3)the coefficients A and B are computed where the diffusive 205 ! fluxes at the t+dt time-step is given by 206 ! Fdiff = A + B Ts(t+dt) 207 ! or Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt 208 ! with F0 = A + B (Ts(t)) 209 ! Capcal = B*dt 210 ! 211 ! Interface: 212 ! ---------- 213 ! 214 ! Arguments: 215 ! ---------- 216 ! ngrid number of grid-points 217 ! ptimestep physical timestep (s) 218 ! pto(ngrid,nsoil) temperature at time-step t (K) 219 ! ptn(ngrid,nsoil) temperature at time step t+dt (K) 220 ! pcapcal(ngrid) specific heat (W*m-2*s*K-1) 221 ! pfluxgrd(ngrid) surface diffusive flux from ground (Wm-2) 222 ! 223 !======================================================================= 224 ! declarations: 225 ! ------------- 226 227 228 !----------------------------------------------------------------------- 229 ! arguments 230 ! --------- 231 232 INTEGER ngrid,nsoil 233 REAL ptimestep 234 REAL ptsrf(ngrid),ptsoil(ngrid,nsoil),ptherm_i(ngrid) 235 REAL pcapcal(ngrid),pfluxgrd(ngrid) 236 LOGICAL firstcall 237 238 239 !----------------------------------------------------------------------- 240 ! local arrays 241 ! ------------ 242 243 INTEGER ig,jk 244 REAL zdz2(nsoil),z1(ngrid) 245 246 IF (firstcall) THEN 247 ! init_soil is now called by iniphyparam 248 ! CALL init_soil(ngrid, nsoil) 249 ELSE 250 IF(.FALSE.) THEN 251 !----------------------------------------------------------------------- 252 ! Computation of the soil temperatures using the Cgrd and Dgrd 253 ! coefficient computed at the previous time-step: 254 ! ----------------------------------------------- 255 256 ! surface temperature 257 DO ig=1,ngrid 258 ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/ & 259 & (lambda*(1.-zd(ig,1))+1.) 260 ENDDO 261 262 ! other temperatures 263 DO jk=1,nsoil-1 264 DO ig=1,ngrid 265 ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk) 266 ENDDO 267 ENDDO 268 ELSE 269 CALL soil_backward(ngrid,nsoil, zc,zd, ptsrf,ptsoil) 270 END IF 271 272 ENDIF 273 274 IF(.FALSE.) THEN 275 !----------------------------------------------------------------------- 276 ! Computation of the Cgrd and Dgrd coefficient for the next step: 277 ! --------------------------------------------------------------- 278 279 DO jk=1,nsoil 280 zdz2(jk)=dz2(jk)/ptimestep 281 ENDDO 282 283 DO ig=1,ngrid 284 z1(ig)=zdz2(nsoil)+dz1(nsoil-1) 285 zc(ig,nsoil-1)=zdz2(nsoil)*ptsoil(ig,nsoil)/z1(ig) 286 zd(ig,nsoil-1)=dz1(nsoil-1)/z1(ig) 287 ENDDO 288 289 DO jk=nsoil-1,2,-1 290 DO ig=1,ngrid 291 z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig,jk))) 292 zc(ig,jk-1)= & 293 & (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))*z1(ig) 294 zd(ig,jk-1)=dz1(jk-1)*z1(ig) 295 ENDDO 296 ENDDO 297 298 !----------------------------------------------------------------------- 299 ! computation of the surface diffusive flux from ground and 300 ! calorific capacity of the ground: 301 ! --------------------------------- 302 303 DO ig=1,ngrid 304 pfluxgrd(ig)=ptherm_i(ig)*dz1(1)* & 305 & (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1)) 306 z1(ig)=lambda*(1.-zd(ig,1))+1. 307 pcapcal(ig)=ptherm_i(ig)* & 308 & ptimestep*(zdz2(1)+(1.-zd(ig,1))*dz1(1))/z1(ig) 309 pfluxgrd(ig)=pfluxgrd(ig) & 310 & +pcapcal(ig)*(ptsoil(ig,1)*z1(ig)-lambda*zc(ig,1)-ptsrf(ig)) & 311 & /ptimestep 312 ENDDO 313 ELSE 314 CALL soil_forward(ngrid, nsoil, ptimestep, ptherm_i, ptsrf, ptsoil, & 315 & zc, zd, pcapcal, pfluxgrd) 316 END IF 317 END SUBROUTINE soil 318 319 END MODULE surface 320 190 END MODULE soil_mod -
dynamico_lmdz/simple_physics/phyparam/python/setup.py
r4236 r4246 6 6 ext_modules = cythonize([ Extension("phyparam",["phyparam.pyx"], 7 7 libraries=['phyparam'], 8 library_dirs=['. '])] )8 library_dirs=['./lib'])] ) 9 9 )
Note: See TracChangeset
for help on using the changeset viewer.