Changeset 3605 for LMDZ6/branches/Ocean_skin/libf/phylmd/physiq_mod.F90
- Timestamp:
- Nov 21, 2019, 4:43:45 PM (4 years ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/physiq_mod.F90 (modified) (133 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
-
LMDZ6/branches/Ocean_skin/libf/phylmd/physiq_mod.F90
r3418 r3605 25 25 USE dimphy 26 26 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac 27 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo 27 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured 28 28 USE mod_phys_lmdz_para 29 29 USE iophy … … 38 38 #ifdef CPP_Dust 39 39 USE phytracr_spl_mod, ONLY: phytracr_spl 40 #endif 41 #ifdef CPP_StratAer 42 USE strataer_mod, ONLY: strataer_init 40 43 #endif 41 44 USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, & … … 117 120 zustar, zu10m, zv10m, rh2m, qsat2m, & 118 121 zq2m, zt2m, weak_inversion, & 122 zq2m_cor,zt2m_cor,zu10m_cor,zv10m_cor, & ! pour corriger d'un bug 123 zrh2m_cor,zqsat2m_cor, & 119 124 zt2m_min_mon, zt2m_max_mon, & ! pour calcul_divers.h 120 125 t2m_min_mon, t2m_max_mon, & ! pour calcul_divers.h … … 170 175 ! Deep convective variables used in phytrac 171 176 pmflxr, pmflxs, & 172 wdtrainA, wdtrain M, &177 wdtrainA, wdtrainS, wdtrainM, & 173 178 upwd, dnwd, & 174 179 ep, & … … 180 185 ev, & 181 186 elij, & 187 qtaa, & 182 188 clw, & 183 189 epmlmMm, eplaMm, & … … 243 249 #endif 244 250 USE indice_sol_mod 245 USE phytrac_mod, ONLY : phytrac 246 USE carbon_cycle_mod, ONLY : infocfields_init 251 USE phytrac_mod, ONLY : phytrac_init, phytrac 252 USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad 247 253 248 254 #ifdef CPP_RRTM … … 265 271 USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando 266 272 USE VERTICAL_LAYERS_MOD, ONLY: aps,bps 273 USE etat0_limit_unstruct_mod 274 #ifdef CPP_XIOS 275 USE xios, ONLY: xios_update_calendar, xios_context_finalize 276 #endif 277 USE limit_read_mod, ONLY : init_limit_read 278 USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz 279 USE readaerosol_mod, ONLY : init_aero_fromfile 280 USE readaerosolstrato_m, ONLY : init_readaerosolstrato 267 281 268 282 IMPLICIT NONE … … 323 337 include "dimpft.h" 324 338 !====================================================================== 339 LOGICAL, SAVE :: ok_volcan ! pour activer les diagnostics volcaniques 340 !$OMP THREADPRIVATE(ok_volcan) 325 341 LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE 326 342 PARAMETER (ok_cvl=.TRUE.) 327 343 LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface 328 344 PARAMETER (ok_gust=.FALSE.) 329 integer iflag_radia ! active ou non le rayonnement (MPL) 330 save iflag_radia 345 INTEGER, SAVE :: iflag_radia ! active ou non le rayonnement (MPL) 331 346 !$OMP THREADPRIVATE(iflag_radia) 332 347 !====================================================================== … … 363 378 !====================================================================== 364 379 LOGICAL ok_journe ! sortir le fichier journalier 365 saveok_journe380 SAVE ok_journe 366 381 !$OMP THREADPRIVATE(ok_journe) 367 382 ! 368 383 LOGICAL ok_mensuel ! sortir le fichier mensuel 369 saveok_mensuel384 SAVE ok_mensuel 370 385 !$OMP THREADPRIVATE(ok_mensuel) 371 386 ! 372 387 LOGICAL ok_instan ! sortir le fichier instantane 373 saveok_instan388 SAVE ok_instan 374 389 !$OMP THREADPRIVATE(ok_instan) 375 390 ! 376 391 LOGICAL ok_LES ! sortir le fichier LES 377 saveok_LES392 SAVE ok_LES 378 393 !$OMP THREADPRIVATE(ok_LES) 379 394 ! 380 395 LOGICAL callstats ! sortir le fichier stats 381 savecallstats396 SAVE callstats 382 397 !$OMP THREADPRIVATE(callstats) 383 398 ! … … 385 400 PARAMETER (ok_region=.FALSE.) 386 401 !====================================================================== 387 realseuil_inversion388 saveseuil_inversion402 REAL seuil_inversion 403 SAVE seuil_inversion 389 404 !$OMP THREADPRIVATE(seuil_inversion) 390 integeriflag_ratqs391 saveiflag_ratqs405 INTEGER iflag_ratqs 406 SAVE iflag_ratqs 392 407 !$OMP THREADPRIVATE(iflag_ratqs) 393 408 real facteur … … 396 411 REAL tau_overturning_th(klon) 397 412 398 integerlmax_th(klon)399 integerlimbas(klon)400 realratqscth(klon,klev)401 realratqsdiff(klon,klev)402 realzqsatth(klon,klev)413 INTEGER lmax_th(klon) 414 INTEGER limbas(klon) 415 REAL ratqscth(klon,klev) 416 REAL ratqsdiff(klon,klev) 417 REAL zqsatth(klon,klev) 403 418 404 419 !====================================================================== … … 497 512 CHARACTER*3 region 498 513 PARAMETER(region='3d') 499 logicalok_hf500 ! 501 saveok_hf514 LOGICAL ok_hf 515 ! 516 SAVE ok_hf 502 517 !$OMP THREADPRIVATE(ok_hf) 503 518 504 INTEGER, PARAMETER :: longcles=20505 REAL, SAVE :: clesphy0(longcles)519 INTEGER, PARAMETER :: longcles=20 520 REAL, SAVE :: clesphy0(longcles) 506 521 !$OMP THREADPRIVATE(clesphy0) 507 522 ! 508 523 ! Variables propres a la physique 509 INTEGER itap 510 SAVE itap ! compteur pour la physique 524 INTEGER, SAVE :: itap ! compteur pour la physique 511 525 !$OMP THREADPRIVATE(itap) 512 526 … … 514 528 !$OMP THREADPRIVATE(abortphy) 515 529 ! 516 REAL, save:: solarlong0530 REAL,SAVE :: solarlong0 517 531 !$OMP THREADPRIVATE(solarlong0) 518 532 … … 531 545 ! Variables liees a la convection de K. Emanuel (sb): 532 546 ! 533 REAL bas, top ! cloud base and top levels 534 SAVE bas 535 SAVE top 547 REAL, SAVE :: bas, top ! cloud base and top levels 536 548 !$OMP THREADPRIVATE(bas, top) 537 549 !------------------------------------------------------------------ … … 551 563 ! Variables li\'ees \`a la poche froide (jyg) 552 564 553 REAL mip(klon,klev) ! mass flux shed by the adiab ascent at each level 565 !! REAL mipsh(klon,klev) ! mass flux shed by the adiab ascent at each level 566 !! Moved to phys_state_var_mod 554 567 ! 555 568 REAL wape_prescr, fip_prescr … … 568 581 !! REAL, DIMENSION(klon,klev) :: dql_sat 569 582 570 real, save :: alp_bl_prescr=0. 571 real, save :: ale_bl_prescr=0. 572 573 real, save :: wake_s_min_lsp=0.1 574 583 REAL, SAVE :: alp_bl_prescr=0. 584 REAL, SAVE :: ale_bl_prescr=0. 585 REAL, SAVE :: wake_s_min_lsp=0.1 575 586 !$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr) 576 587 !$OMP THREADPRIVATE(wake_s_min_lsp) 577 588 578 579 real ok_wk_lsp(klon) 589 REAL ok_wk_lsp(klon) 580 590 581 591 !RC … … 590 600 ! gust-front in the grid cell. 591 601 !$OMP THREADPRIVATE(iflag_alp_wk_cond) 602 603 INTEGER, SAVE :: iflag_bug_t2m_ipslcm61=1 ! 604 !$OMP THREADPRIVATE(iflag_bug_t2m_ipslcm61) 605 INTEGER, SAVE :: iflag_bug_t2m_stab_ipslcm61=-1 ! 606 !$OMP THREADPRIVATE(iflag_bug_t2m_stab_ipslcm61) 607 592 608 REAL t_w(klon,klev),q_w(klon,klev) ! temperature and moisture profiles in the wake region 593 609 REAL t_x(klon,klev),q_x(klon,klev) ! temperature and moisture profiles in the off-wake region … … 727 743 REAL :: jD_eq 728 744 729 LOGICAL, parameter :: new_orbit = . true.745 LOGICAL, parameter :: new_orbit = .TRUE. 730 746 731 747 ! … … 913 929 INTEGER kcbot(klon), kctop(klon), kdtop(klon) 914 930 ! 915 realratqsbas,ratqshaut,tau_ratqs916 saveratqsbas,ratqshaut,tau_ratqs931 REAL ratqsbas,ratqshaut,tau_ratqs 932 SAVE ratqsbas,ratqshaut,tau_ratqs 917 933 !$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs) 918 934 REAL, SAVE :: ratqsp0=50000., ratqsdp=20000. … … 920 936 921 937 ! Parametres lies au nouveau schema de nuages (SB, PDF) 922 realfact_cldcon923 realfacttemps924 logical ok_newmicro925 saveok_newmicro938 REAL, SAVE :: fact_cldcon 939 REAL, SAVE :: facttemps 940 !$OMP THREADPRIVATE(fact_cldcon,facttemps) 941 LOGICAL, SAVE :: ok_newmicro 926 942 !$OMP THREADPRIVATE(ok_newmicro) 927 !real ref_liq_pi(klon,klev), ref_ice_pi(klon,klev) 928 save fact_cldcon,facttemps 929 !$OMP THREADPRIVATE(fact_cldcon,facttemps) 930 931 integer iflag_cld_th 932 save iflag_cld_th 943 944 INTEGER, SAVE :: iflag_cld_th 933 945 !$OMP THREADPRIVATE(iflag_cld_th) 934 946 !IM logical ptconv(klon,klev) !passe dans phys_local_var_mod 935 947 !IM cf. AM 081204 BEG 936 logicalptconvth(klon,klev)948 LOGICAL ptconvth(klon,klev) 937 949 !IM cf. AM 081204 END 938 950 ! … … 941 953 !====================================================================== 942 954 ! 943 944 955 ! 945 956 !JLD integer itau_w ! pas de temps ecriture = itap + itau_phy … … 1007 1018 !JLD REAL zstophy, zout 1008 1019 1009 character*20 modname1010 character*80 abort_message1011 logical, save:: ok_sync, ok_sync_omp1020 CHARACTER*20 modname 1021 CHARACTER*80 abort_message 1022 LOGICAL, SAVE :: ok_sync, ok_sync_omp 1012 1023 !$OMP THREADPRIVATE(ok_sync) 1013 realdate01024 REAL date0 1014 1025 1015 1026 ! essai writephys 1016 integer fid_day, fid_mth, fid_ins 1017 parameter (fid_ins = 1, fid_day = 2, fid_mth = 3) 1018 integer prof2d_on, prof3d_on, prof2d_av, prof3d_av 1019 parameter (prof2d_on = 1, prof3d_on = 2, & 1020 prof2d_av = 3, prof3d_av = 4) 1027 INTEGER fid_day, fid_mth, fid_ins 1028 PARAMETER (fid_ins = 1, fid_day = 2, fid_mth = 3) 1029 INTEGER prof2d_on, prof3d_on, prof2d_av, prof3d_av 1030 PARAMETER (prof2d_on = 1, prof3d_on = 2, prof2d_av = 3, prof3d_av = 4) 1021 1031 REAL ztsol(klon) 1022 1032 REAL q2m(klon,nbsrf) ! humidite a 2m … … 1070 1080 ! Declaration des constantes et des fonctions thermodynamiques 1071 1081 ! 1072 LOGICAL,SAVE :: first=. true.1082 LOGICAL,SAVE :: first=.TRUE. 1073 1083 !$OMP THREADPRIVATE(first) 1074 1084 … … 1106 1116 ! Declarations pour Simulateur COSP 1107 1117 !============================================================ 1108 real :: mr_ozone(klon,klev) 1118 real :: mr_ozone(klon,klev), phicosp(klon,klev) 1109 1119 1110 1120 !IM stations CFMIP … … 1164 1174 REAL zzz 1165 1175 !albedo SB >>> 1166 real,dimension(6),save :: SFRWL 1176 REAL,DIMENSION(6), SAVE :: SFRWL 1177 !$OMP THREADPRIVATE(SFRWL) 1167 1178 !albedo SB <<< 1168 1179 1169 1180 !--OB variables for mass fixer (hard coded for now) 1170 logical, parameter :: mass_fixer=.false.1171 realqql1(klon),qql2(klon),corrqql1181 LOGICAL, PARAMETER :: mass_fixer=.FALSE. 1182 REAL qql1(klon),qql2(klon),corrqql 1172 1183 1173 1184 REAL pi … … 1183 1194 pdtphys=pdtphys_ 1184 1195 CALL update_time(pdtphys) 1196 phys_tstep=NINT(pdtphys) 1197 #ifdef CPP_XIOS 1198 IF (.NOT. debut .AND. is_omp_master) CALL xios_update_calendar(itap+1) 1199 #endif 1185 1200 1186 1201 !====================================================================== … … 1211 1226 1212 1227 ! Quick check on pressure levels: 1213 callassert(paprs(:, nbp_lev + 1) < paprs(:, nbp_lev), &1228 CALL assert(paprs(:, nbp_lev + 1) < paprs(:, nbp_lev), & 1214 1229 "physiq_mod paprs bad order") 1215 1230 1216 1231 IF (first) THEN 1232 CALL init_etat0_limit_unstruct 1233 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) 1217 1234 !CR:nvelles variables convection/poches froides 1218 1235 1219 print*, '=================================================' 1220 print*, 'Allocation des variables locales et sauvegardees' 1236 WRITE(lunout,*) '=================================================' 1237 WRITE(lunout,*) 'Allocation des variables locales et sauvegardees' 1238 WRITE(lunout,*) '=================================================' 1221 1239 CALL phys_local_var_init 1222 1240 ! 1223 pasphys=pdtphys1224 1241 ! appel a la lecture du run.def physique 1225 1242 CALL conf_phys(ok_journe, ok_mensuel, & … … 1230 1247 fact_cldcon, facttemps,ok_newmicro,iflag_radia, & 1231 1248 iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, & 1232 ok_ade, ok_aie, ok_alw, ok_cdnc, aerosol_couple, chemistry_couple, & 1249 ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, aerosol_couple, & 1250 chemistry_couple, & 1233 1251 flag_aerosol, flag_aerosol_strat, flag_aer_feedback, new_aod, & 1234 1252 flag_bc_internal_mixture, bl95_b0, bl95_b1, & … … 1239 1257 CALL phys_state_var_init(read_climoz) 1240 1258 CALL phys_output_var_init 1259 IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) & 1260 CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz) 1261 1262 #ifdef CPP_StratAer 1263 CALL strataer_init 1264 #endif 1265 1241 1266 print*, '=================================================' 1242 1267 ! … … 1245 1270 WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', & 1246 1271 '(H2Ov, H2Ol, H2Oi) but nqo=', nqo, '. Might as well stop here.' 1247 STOP 1272 abort_message='see above' 1273 CALL abort_physic(modname,abort_message,1) 1248 1274 ENDIF 1249 1275 … … 1258 1284 1259 1285 itau_con=0 1260 first=. false.1286 first=.FALSE. 1261 1287 1262 1288 ENDIF ! first … … 1287 1313 ! secondes 1288 1314 tau_gl=86400.*tau_gl 1289 print*,'debut physiq_mod tau_gl=',tau_gl 1315 WRITE(lunout,*) 'debut physiq_mod tau_gl=',tau_gl 1316 1317 iflag_bug_t2m_ipslcm61 = 1 1318 CALL getin_p('iflag_bug_t2m_ipslcm61', iflag_bug_t2m_ipslcm61) 1319 iflag_bug_t2m_stab_ipslcm61 = -1 1320 CALL getin_p('iflag_bug_t2m_stab_ipslcm61', iflag_bug_t2m_stab_ipslcm61) 1321 1290 1322 CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond) 1291 1323 CALL getin_p('random_notrig_max',random_notrig_max) … … 1318 1350 CALL getin_p('NVM',nvm_lmdz) 1319 1351 1352 WRITE(lunout,*) 'iflag_alp_wk_cond=', iflag_alp_wk_cond 1353 WRITE(lunout,*) 'random_ntrig_max=', random_notrig_max 1354 WRITE(lunout,*) 'ok_adjwk=', ok_adjwk 1355 WRITE(lunout,*) 'iflag_adjwk=', iflag_adjwk 1356 WRITE(lunout,*) 'qtcon_multistep_max=',dtcon_multistep_max 1357 WRITE(lunout,*) 'qdcon_multistep_max=',dqcon_multistep_max 1358 WRITE(lunout,*) 'ratqsp0=', ratqsp0 1359 WRITE(lunout,*) 'ratqsdp=', ratqsdp 1360 WRITE(lunout,*) 'iflag_wake_tend=', iflag_wake_tend 1361 WRITE(lunout,*) 'ok_bad_ecmwf_thermo=',ok_bad_ecmwf_thermo 1362 WRITE(lunout,*) 'ok_bug_cv_trac=', ok_bug_cv_trac 1363 WRITE(lunout,*) 'ok_bug_split_th=', ok_bug_split_th 1364 WRITE(lunout,*) 'fl_ebil=', fl_ebil 1365 WRITE(lunout,*) 'fl_cor_ebil=', fl_cor_ebil 1366 WRITE(lunout,*) 'iflag_phytrac=', iflag_phytrac 1367 WRITE(lunout,*) 'NVM=', nvm_lmdz 1368 1320 1369 !--PC: defining fields to be exchanged between LMDz, ORCHIDEE and NEMO 1321 1370 WRITE(lunout,*) 'Call to infocfields from physiq' … … 1369 1418 ENDIF 1370 1419 1420 tau_aero(:,:,:,:) = 1.e-15 1421 piz_aero(:,:,:,:) = 1. 1422 cg_aero(:,:,:,:) = 0. 1423 1371 1424 IF (aerosol_couple .AND. (config_inca /= "aero" & 1372 1425 .AND. config_inca /= "aeNP ")) THEN … … 1376 1429 CALL abort_physic (modname,abort_message,1) 1377 1430 ENDIF 1378 1379 1380 1431 1381 1432 rnebcon0(:,:) = 0.0 … … 1417 1468 ! pour obtenir le meme resultat. 1418 1469 !jyg for fh< 1419 !! dtime=pdtphys 1420 dtime=NINT(pdtphys) 1421 WRITE(lunout,*) 'Pas de temps dtime pdtphys ',dtime,pdtphys 1422 IF (abs(dtime-pdtphys)>1.e-10) THEN 1470 WRITE(lunout,*) 'Pas de temps phys_tstep pdtphys ',phys_tstep,pdtphys 1471 IF (abs(phys_tstep-pdtphys)>1.e-10) THEN 1423 1472 abort_message='pas de temps doit etre entier en seconde pour orchidee et XIOS' 1424 1473 CALL abort_physic(modname,abort_message,1) 1425 1474 ENDIF 1426 1475 !>jyg 1427 IF (MOD(NINT(86400./ dtime),nbapp_rad).EQ.0) THEN1428 radpas = NINT( 86400./ dtime)/nbapp_rad1476 IF (MOD(NINT(86400./phys_tstep),nbapp_rad).EQ.0) THEN 1477 radpas = NINT( 86400./phys_tstep)/nbapp_rad 1429 1478 ELSE 1430 1479 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', & … … 1436 1485 CALL abort_physic(modname,abort_message,1) 1437 1486 ENDIF 1438 IF (nbapp_cv .EQ. 0) nbapp_cv=86400./ dtime1439 IF (nbapp_wk .EQ. 0) nbapp_wk=86400./ dtime1487 IF (nbapp_cv .EQ. 0) nbapp_cv=86400./phys_tstep 1488 IF (nbapp_wk .EQ. 0) nbapp_wk=86400./phys_tstep 1440 1489 print *,'physiq, nbapp_cv, nbapp_wk ',nbapp_cv,nbapp_wk 1441 IF (MOD(NINT(86400./ dtime),nbapp_cv).EQ.0) THEN1442 cvpas_0 = NINT( 86400./ dtime)/nbapp_cv1490 IF (MOD(NINT(86400./phys_tstep),nbapp_cv).EQ.0) THEN 1491 cvpas_0 = NINT( 86400./phys_tstep)/nbapp_cv 1443 1492 cvpas = cvpas_0 1444 1493 print *,'physiq, cvpas ',cvpas … … 1450 1499 abort_message='nbre de pas de temps physique n est pas multiple ' & 1451 1500 // 'de nbapp_cv' 1452 callabort_physic(modname,abort_message,1)1453 ENDIF 1454 IF (MOD(NINT(86400./ dtime),nbapp_wk).EQ.0) THEN1455 wkpas = NINT( 86400./ dtime)/nbapp_wk1456 print *,'physiq, wkpas ',wkpas1501 CALL abort_physic(modname,abort_message,1) 1502 ENDIF 1503 IF (MOD(NINT(86400./phys_tstep),nbapp_wk).EQ.0) THEN 1504 wkpas = NINT( 86400./phys_tstep)/nbapp_wk 1505 ! print *,'physiq, wkpas ',wkpas 1457 1506 ELSE 1458 1507 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', & … … 1462 1511 abort_message='nbre de pas de temps physique n est pas multiple ' & 1463 1512 // 'de nbapp_wk' 1464 callabort_physic(modname,abort_message,1)1513 CALL abort_physic(modname,abort_message,1) 1465 1514 ENDIF 1466 1515 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1467 1516 CALL init_iophy_new(latitude_deg,longitude_deg) 1517 1518 !=================================================================== 1519 !IM stations CFMIP 1520 nCFMIP=npCFMIP 1521 OPEN(98,file='npCFMIP_param.data',status='old', & 1522 form='formatted',iostat=iostat) 1523 IF (iostat == 0) THEN 1524 READ(98,*,end=998) nCFMIP 1525 998 CONTINUE 1526 CLOSE(98) 1527 CONTINUE 1528 IF(nCFMIP.GT.npCFMIP) THEN 1529 print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler' 1530 CALL abort_physic("physiq", "", 1) 1531 ELSE 1532 print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP 1533 ENDIF 1534 1535 ! 1536 ALLOCATE(tabCFMIP(nCFMIP)) 1537 ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP)) 1538 ALLOCATE(tabijGCM(nCFMIP)) 1539 ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP)) 1540 ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP)) 1541 ! 1542 ! lecture des nCFMIP stations CFMIP, de leur numero 1543 ! et des coordonnees geographiques lonCFMIP, latCFMIP 1544 ! 1545 CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, & 1546 lonCFMIP, latCFMIP) 1547 ! 1548 ! identification des 1549 ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la 1550 ! grille de LMDZ 1551 ! 2) indices points tabijGCM de la grille physique 1d sur 1552 ! klon points 1553 ! 3) indices iGCM, jGCM de la grille physique 2d 1554 ! 1555 CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, & 1556 tabijGCM, lonGCM, latGCM, iGCM, jGCM) 1557 ! 1558 ELSE 1559 ALLOCATE(tabijGCM(0)) 1560 ALLOCATE(lonGCM(0), latGCM(0)) 1561 ALLOCATE(iGCM(0), jGCM(0)) 1562 ENDIF 1563 1564 #ifdef CPP_IOIPSL 1565 1566 !$OMP MASTER 1567 ! FH : if ok_sync=.true. , the time axis is written at each time step 1568 ! in the output files. Only at the end in the opposite case 1569 ok_sync_omp=.FALSE. 1570 CALL getin('ok_sync',ok_sync_omp) 1571 CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, & 1572 iGCM,jGCM,lonGCM,latGCM, & 1573 jjmp1,nlevSTD,clevSTD,rlevSTD, phys_tstep,ok_veget, & 1574 type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, & 1575 ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, & 1576 read_climoz, phys_out_filestations, & 1577 new_aod, aerosol_couple, & 1578 flag_aerosol_strat, pdtphys, paprs, pphis, & 1579 pplay, lmax_th, ptconv, ptconvth, ivap, & 1580 d_u, d_t, qx, d_qx, zmasse, ok_sync_omp) 1581 !$OMP END MASTER 1582 !$OMP BARRIER 1583 ok_sync=ok_sync_omp 1584 1585 freq_outNMC(1) = ecrit_files(7) 1586 freq_outNMC(2) = ecrit_files(8) 1587 freq_outNMC(3) = ecrit_files(9) 1588 WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1) 1589 WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2) 1590 WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3) 1591 1592 #ifndef CPP_XIOS 1593 CALL ini_paramLMDZ_phy(phys_tstep,nid_ctesGCM) 1594 #endif 1595 1596 #endif 1597 ecrit_reg = ecrit_reg * un_jour 1598 ecrit_tra = ecrit_tra * un_jour 1599 1600 !XXXPB Positionner date0 pour initialisation de ORCHIDEE 1601 date0 = jD_ref 1602 WRITE(*,*) 'physiq date0 : ',date0 1603 ! 1604 1605 ! CALL create_climoz(read_climoz) 1606 IF (.NOT. create_etat0_limit) CALL init_aero_fromfile(flag_aerosol) !! initialise aero from file for XIOS interpolation (unstructured_grid) 1607 IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat) !! initialise aero strato from file for XIOS interpolation (unstructured_grid) 1608 1609 #ifdef CPP_COSP 1610 IF (ok_cosp) THEN 1611 DO k = 1, klev 1612 DO i = 1, klon 1613 phicosp(i,k) = pphi(i,k) + pphis(i) 1614 ENDDO 1615 ENDDO 1616 CALL phys_cosp(itap,phys_tstep,freq_cosp, & 1617 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 1618 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & 1619 klon,klev,longitude_deg,latitude_deg,presnivs,overlap, & 1620 JrNt,ref_liq,ref_ice, & 1621 pctsrf(:,is_ter)+pctsrf(:,is_lic), & 1622 zu10m,zv10m,pphis, & 1623 zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, & 1624 qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, & 1625 prfl(:,1:klev),psfl(:,1:klev), & 1626 pmflxr(:,1:klev),pmflxs(:,1:klev), & 1627 mr_ozone,cldtau, cldemi) 1628 ENDIF 1629 #endif 1630 1631 #ifdef CPP_COSP2 1632 IF (ok_cosp) THEN 1633 DO k = 1, klev 1634 DO i = 1, klon 1635 phicosp(i,k) = pphi(i,k) + pphis(i) 1636 ENDDO 1637 ENDDO 1638 CALL phys_cosp2(itap,phys_tstep,freq_cosp, & 1639 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 1640 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & 1641 klon,klev,longitude_deg,latitude_deg,presnivs,overlap, & 1642 JrNt,ref_liq,ref_ice, & 1643 pctsrf(:,is_ter)+pctsrf(:,is_lic), & 1644 zu10m,zv10m,pphis, & 1645 zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, & 1646 qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, & 1647 prfl(:,1:klev),psfl(:,1:klev), & 1648 pmflxr(:,1:klev),pmflxs(:,1:klev), & 1649 mr_ozone,cldtau, cldemi) 1650 ENDIF 1651 #endif 1652 1653 #ifdef CPP_COSPV2 1654 IF (ok_cosp) THEN 1655 DO k = 1, klev 1656 DO i = 1, klon 1657 phicosp(i,k) = pphi(i,k) + pphis(i) 1658 ENDDO 1659 ENDDO 1660 CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, & 1661 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 1662 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & 1663 klon,klev,longitude_deg,latitude_deg,presnivs,overlap, & 1664 JrNt,ref_liq,ref_ice, & 1665 pctsrf(:,is_ter)+pctsrf(:,is_lic), & 1666 zu10m,zv10m,pphis, & 1667 phicosp,paprs(:,1:klev),pplay,zxtsol,t_seri, & 1668 qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, & 1669 prfl(:,1:klev),psfl(:,1:klev), & 1670 pmflxr(:,1:klev),pmflxs(:,1:klev), & 1671 mr_ozone,cldtau, cldemi) 1672 ENDIF 1673 #endif 1674 1675 ! 1676 ! 1677 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1678 ! Nouvelle initialisation pour le rayonnement RRTM 1679 ! 1680 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1681 1682 CALL iniradia(klon,klev,paprs(1,1:klev+1)) 1683 ! Initialisation des champs dans phytrac qui sont utilisés par phys_output_write 1684 IF (iflag_phytrac == 1 ) THEN 1685 CALL phytrac_init() 1686 ENDIF 1687 1688 CALL phys_output_write(itap, pdtphys, paprs, pphis, & 1689 pplay, lmax_th, aerosol_couple, & 1690 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, new_aod, ok_sync,& 1691 ptconv, read_climoz, clevSTD, & 1692 ptconvth, d_u, d_t, qx, d_qx, zmasse, & 1693 flag_aerosol, flag_aerosol_strat, ok_cdnc) 1694 1695 #ifdef CPP_XIOS 1696 IF (is_omp_master) CALL xios_update_calendar(1) 1697 #endif 1698 IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz) 1699 CALL create_etat0_limit_unstruct 1468 1700 CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0) 1701 1469 1702 !jyg< 1470 IF (klon_glo==1) THEN 1471 IF (iflag_pbl > 1) THEN 1472 pbl_tke(:,:,is_ave) = 0. 1473 DO nsrf=1,nbsrf 1474 DO k = 1,klev+1 1475 pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) & 1476 +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf) 1477 ENDDO 1478 ENDDO 1479 ELSE ! (iflag_pbl > 1) 1480 pbl_tke(:,:,:) = 0. 1481 ENDIF ! (iflag_pbl > 1) 1703 IF (iflag_pbl<=1) THEN 1704 ! No TKE for Standard Physics 1705 pbl_tke(:,:,:)=0. 1706 1707 ELSE IF (klon_glo==1) THEN 1708 pbl_tke(:,:,is_ave) = 0. 1709 DO nsrf=1,nbsrf 1710 DO k = 1,klev+1 1711 pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) & 1712 +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf) 1713 ENDDO 1714 ENDDO 1715 ELSE 1716 pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ?? 1482 1717 !>jyg 1483 1718 ENDIF … … 1496 1731 ENDIF 1497 1732 1498 CALL printflag( tabcntr0,radpas,ok_journe, & 1499 ok_instan, ok_region ) 1500 ! 1501 IF (ABS(dtime-pdtphys).GT.0.001) THEN 1502 WRITE(lunout,*) 'Pas physique n est pas correct',dtime, & 1503 pdtphys 1504 abort_message='Pas physique n est pas correct ' 1505 ! call abort_physic(modname,abort_message,1) 1506 dtime=pdtphys 1507 ENDIF 1733 ! IF (ABS(phys_tstep-pdtphys).GT.0.001) THEN 1734 ! WRITE(lunout,*) 'Pas physique n est pas correct',phys_tstep, & 1735 ! pdtphys 1736 ! abort_message='Pas physique n est pas correct ' 1737 ! ! call abort_physic(modname,abort_message,1) 1738 ! phys_tstep=pdtphys 1739 ! ENDIF 1508 1740 IF (nlon .NE. klon) THEN 1509 1741 WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, & … … 1519 1751 ENDIF 1520 1752 ! 1521 IF ( dtime*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN1753 IF (phys_tstep*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN 1522 1754 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant' 1523 1755 WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne" … … 1581 1813 ! enddo 1582 1814 1583 !=================================================================== 1584 !IM stations CFMIP 1585 nCFMIP=npCFMIP 1586 OPEN(98,file='npCFMIP_param.data',status='old', & 1587 form='formatted',iostat=iostat) 1588 IF (iostat == 0) THEN 1589 READ(98,*,end=998) nCFMIP 1590 998 CONTINUE 1591 CLOSE(98) 1592 CONTINUE 1593 IF(nCFMIP.GT.npCFMIP) THEN 1594 print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler' 1595 CALL abort_physic("physiq", "", 1) 1596 ELSE 1597 print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP 1598 ENDIF 1599 1600 ! 1601 ALLOCATE(tabCFMIP(nCFMIP)) 1602 ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP)) 1603 ALLOCATE(tabijGCM(nCFMIP)) 1604 ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP)) 1605 ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP)) 1606 ! 1607 ! lecture des nCFMIP stations CFMIP, de leur numero 1608 ! et des coordonnees geographiques lonCFMIP, latCFMIP 1609 ! 1610 CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, & 1611 lonCFMIP, latCFMIP) 1612 ! 1613 ! identification des 1614 ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la 1615 ! grille de LMDZ 1616 ! 2) indices points tabijGCM de la grille physique 1d sur 1617 ! klon points 1618 ! 3) indices iGCM, jGCM de la grille physique 2d 1619 ! 1620 CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, & 1621 tabijGCM, lonGCM, latGCM, iGCM, jGCM) 1622 ! 1623 ELSE 1624 ALLOCATE(tabijGCM(0)) 1625 ALLOCATE(lonGCM(0), latGCM(0)) 1626 ALLOCATE(iGCM(0), jGCM(0)) 1627 ENDIF 1628 ELSE 1629 ALLOCATE(tabijGCM(0)) 1630 ALLOCATE(lonGCM(0), latGCM(0)) 1631 ALLOCATE(iGCM(0), jGCM(0)) 1815 !ELSE 1816 ! ALLOCATE(tabijGCM(0)) 1817 ! ALLOCATE(lonGCM(0), latGCM(0)) 1818 ! ALLOCATE(iGCM(0), jGCM(0)) 1632 1819 ENDIF 1633 1820 … … 1665 1852 ! 1666 1853 ! 1667 lmt_pas = NINT(86400./ dtime* 1.0) ! tous les jours1854 lmt_pas = NINT(86400./phys_tstep * 1.0) ! tous les jours 1668 1855 WRITE(lunout,*)'La frequence de lecture surface est de ', & 1669 1856 lmt_pas … … 1681 1868 ! Initialisation des sorties 1682 1869 !============================================================= 1870 1871 #ifdef CPP_XIOS 1872 ! Get "missing_val" value from XML files (from temperature variable) 1873 !$OMP MASTER 1874 CALL xios_get_field_attr("temp",default_value=missing_val_omp) 1875 !$OMP END MASTER 1876 !$OMP BARRIER 1877 missing_val=missing_val_omp 1878 #endif 1683 1879 1684 1880 #ifdef CPP_XIOS … … 1693 1889 #endif 1694 1890 1695 #ifdef CPP_IOIPSL 1696 1697 !$OMP MASTER 1698 ! FH : if ok_sync=.true. , the time axis is written at each time step 1699 ! in the output files. Only at the end in the opposite case 1700 ok_sync_omp=.false. 1701 CALL getin('ok_sync',ok_sync_omp) 1702 CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, & 1703 iGCM,jGCM,lonGCM,latGCM, & 1704 jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, & 1705 type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, & 1706 ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, & 1707 read_climoz, phys_out_filestations, & 1708 new_aod, aerosol_couple, & 1709 flag_aerosol_strat, pdtphys, paprs, pphis, & 1710 pplay, lmax_th, ptconv, ptconvth, ivap, & 1711 d_u, d_t, qx, d_qx, zmasse, ok_sync_omp) 1712 !$OMP END MASTER 1713 !$OMP BARRIER 1714 ok_sync=ok_sync_omp 1715 1716 freq_outNMC(1) = ecrit_files(7) 1717 freq_outNMC(2) = ecrit_files(8) 1718 freq_outNMC(3) = ecrit_files(9) 1719 WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1) 1720 WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2) 1721 WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3) 1722 1723 #ifndef CPP_XIOS 1724 CALL ini_paramLMDZ_phy(dtime,nid_ctesGCM) 1725 #endif 1726 1727 #endif 1728 ecrit_reg = ecrit_reg * un_jour 1729 ecrit_tra = ecrit_tra * un_jour 1730 1731 !XXXPB Positionner date0 pour initialisation de ORCHIDEE 1732 date0 = jD_ref 1733 WRITE(*,*) 'physiq date0 : ',date0 1891 1892 CALL printflag( tabcntr0,radpas,ok_journe, & 1893 ok_instan, ok_region ) 1734 1894 ! 1735 1895 ! … … 1792 1952 #endif 1793 1953 ENDIF 1794 !1795 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1796 ! Nouvelle initialisation pour le rayonnement RRTM1797 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1798 1799 CALL iniradia(klon,klev,paprs(1,1:klev+1))1800 1954 1801 1955 !$omp single … … 1815 1969 1816 1970 !albedo SB >>> 1817 select case(nsw)1818 case(2)1971 SELECT CASE(nsw) 1972 CASE(2) 1819 1973 SFRWL(1)=0.45538747 1820 1974 SFRWL(2)=0.54461211 1821 case(4)1975 CASE(4) 1822 1976 SFRWL(1)=0.45538747 1823 1977 SFRWL(2)=0.32870591 1824 1978 SFRWL(3)=0.18568763 1825 1979 SFRWL(4)=3.02191470E-02 1826 case(6)1980 CASE(6) 1827 1981 SFRWL(1)=1.28432794E-03 1828 1982 SFRWL(2)=0.12304168 … … 1831 1985 SFRWL(5)=0.18568763 1832 1986 SFRWL(6)=3.02191470E-02 1833 end select1987 END SELECT 1834 1988 1835 1989 … … 1870 2024 sollwdown(:)= sollwdown(:) + betalwoff *(-1.*ZFLDN0(:,1) - & 1871 2025 sollwdown(:)) 2026 2027 1872 2028 ENDIF 1873 2029 ! … … 1891 2047 ! on the surface fraction. 1892 2048 ! 1893 CALL change_srf_frac(itap, dtime, days_elapsed+1, &2049 CALL change_srf_frac(itap, phys_tstep, days_elapsed+1, & 1894 2050 pctsrf, fevap, z0m, z0h, agesno, & 1895 2051 falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke) … … 1903 2059 #endif 1904 2060 ENDIF 1905 1906 2061 1907 2062 ! Tendances bidons pour les processus qui n'affectent pas certaines … … 2005 2160 ENDDO 2006 2161 ENDIF 2162 ! 2163 ! Temporary solutions adressing ticket #104 and the non initialisation of tr_ancien 2164 ! LF 2165 IF (debut) THEN 2166 WRITE(lunout,*)' WARNING: tr_ancien initialised to tr_seri' 2167 DO iq = nqo+1, nqtot 2168 tr_ancien(:,:,iq-nqo)=tr_seri(:,:,iq-nqo) 2169 ENDDO 2170 ENDIF 2007 2171 ! 2008 2172 DO i = 1, klon … … 2021 2185 IF (ancien_ok) THEN 2022 2186 ! 2023 d_u_dyn(:,:) = (u_seri(:,:)-u_ancien(:,:))/ dtime2024 d_v_dyn(:,:) = (v_seri(:,:)-v_ancien(:,:))/ dtime2025 d_t_dyn(:,:) = (t_seri(:,:)-t_ancien(:,:))/ dtime2026 d_q_dyn(:,:) = (q_seri(:,:)-q_ancien(:,:))/ dtime2027 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/ dtime2028 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/ dtime2187 d_u_dyn(:,:) = (u_seri(:,:)-u_ancien(:,:))/phys_tstep 2188 d_v_dyn(:,:) = (v_seri(:,:)-v_ancien(:,:))/phys_tstep 2189 d_t_dyn(:,:) = (t_seri(:,:)-t_ancien(:,:))/phys_tstep 2190 d_q_dyn(:,:) = (q_seri(:,:)-q_ancien(:,:))/phys_tstep 2191 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep 2192 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep 2029 2193 CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d) 2030 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/ dtime2194 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep 2031 2195 CALL water_int(klon,klev,ql_seri,zmasse,zx_tmp_fi2d) 2032 d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/ dtime2196 d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/phys_tstep 2033 2197 CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d) 2034 d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/ dtime2198 d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep 2035 2199 ! !! RomP >>> td dyn traceur 2036 2200 IF (nqtot.GT.nqo) THEN ! jyg 2037 2201 DO iq = nqo+1, nqtot ! jyg 2038 d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/ dtime! jyg2202 d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/phys_tstep ! jyg 2039 2203 ENDDO 2040 2204 ENDIF … … 2138 2302 ro3i, 'C', press_cen_climoz, pplay, wo, paprs(:,1), & 2139 2303 time_climoz ) 2140 END 2304 ENDIF 2141 2305 ! Convert from mole fraction of ozone to column density of ozone in a 2142 2306 ! cell, in kDU: … … 2158 2322 (du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva,paprs,& 2159 2323 'eva',abortphy,flag_inhib_tend,itap,0) 2160 callprt_enerbil('eva',itap)2324 CALL prt_enerbil('eva',itap) 2161 2325 2162 2326 !========================================================================= … … 2213 2377 ! bit comparable a l ancienne formulation cycle_diurne=true 2214 2378 ! on integre entre gmtime et gmtime+radpas 2215 zdtime= dtime*REAL(radpas) ! pas de temps du rayonnement (s)2379 zdtime=phys_tstep*REAL(radpas) ! pas de temps du rayonnement (s) 2216 2380 CALL zenang(zlongi,jH_cur,0.0,zdtime, & 2217 2381 latitude_deg,longitude_deg,rmu0,fract) … … 2230 2394 ! premier pas de temps de la physique pendant lequel 2231 2395 ! itaprad=0 2232 zdtime1= dtime*REAL(-MOD(itaprad,radpas)-1)2233 zdtime2= dtime*REAL(radpas-MOD(itaprad,radpas)-1)2396 zdtime1=phys_tstep*REAL(-MOD(itaprad,radpas)-1) 2397 zdtime2=phys_tstep*REAL(radpas-MOD(itaprad,radpas)-1) 2234 2398 CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, & 2235 2399 latitude_deg,longitude_deg,rmu0,fract) … … 2237 2401 ! Calcul des poids 2238 2402 ! 2239 zdtime1=- dtime!--on corrige le rayonnement pour representer le2403 zdtime1=-phys_tstep !--on corrige le rayonnement pour representer le 2240 2404 zdtime2=0.0 !--pas de temps de la physique qui se termine 2241 2405 CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, & … … 2295 2459 ! 2296 2460 !-------gustiness calculation-------! 2461 !ym : Warning gustiness non inialized for iflag_gusts=2 & iflag_gusts=3 2462 gustiness=0 !ym missing init 2463 2297 2464 IF (iflag_gusts==0) THEN 2298 2465 gustiness(1:klon)=0 … … 2312 2479 ENDIF 2313 2480 2314 2315 2316 2481 CALL pbl_surface( & 2317 dtime, date0, itap, days_elapsed+1, &2482 phys_tstep, date0, itap, days_elapsed+1, & 2318 2483 debut, lafin, & 2319 2484 longitude_deg, latitude_deg, rugoro, zrmu0, & … … 2382 2547 ENDIF 2383 2548 2384 2385 2386 2549 !add limitation for t,q at and wind at 10m 2550 if ( iflag_bug_t2m_ipslcm61 == 0 ) THEN 2551 CALL borne_var_surf( klon,klev,nbsrf, & 2552 iflag_bug_t2m_stab_ipslcm61, & 2553 t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1), & 2554 ftsol,zxqsurf,pctsrf,paprs, & 2555 t2m, q2m, u10m, v10m, & 2556 zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor, & 2557 zrh2m_cor, zqsat2m_cor) 2558 ELSE 2559 zt2m_cor(:)=zt2m(:) 2560 zq2m_cor(:)=zq2m(:) 2561 zu10m_cor(:)=zu10m(:) 2562 zv10m_cor(:)=zv10m(:) 2563 zqsat2m_cor=999.999 2564 ENDIF 2387 2565 2388 2566 !--------------------------------------------------------------------- … … 2397 2575 'vdf',abortphy,flag_inhib_tend,itap,0) 2398 2576 ENDIF 2399 callprt_enerbil('vdf',itap)2577 CALL prt_enerbil('vdf',itap) 2400 2578 !-------------------------------------------------------------------- 2401 2579 … … 2482 2660 DO i = 1, klon 2483 2661 conv_q(i,k) = d_q_dyn(i,k) & 2484 + d_q_vdf(i,k)/ dtime2662 + d_q_vdf(i,k)/phys_tstep 2485 2663 conv_t(i,k) = d_t_dyn(i,k) & 2486 + d_t_vdf(i,k)/ dtime2664 + d_t_vdf(i,k)/phys_tstep 2487 2665 ENDDO 2488 2666 ENDDO … … 2528 2706 pmflxs(:,:) = 0. 2529 2707 wdtrainA(:,:) = 0. 2708 wdtrainS(:,:) = 0. 2530 2709 wdtrainM(:,:) = 0. 2531 2710 upwd(:,:) = 0. … … 2543 2722 elij(:,:,:)=0. 2544 2723 ev(:,:)=0. 2724 qtaa(:,:)=0. 2545 2725 clw(:,:)=0. 2546 2726 sij(:,:,:)=0. … … 2549 2729 abort_message ='reactiver le call conlmd dans physiq.F' 2550 2730 CALL abort_physic (modname,abort_message,1) 2551 ! CALL conlmd ( dtime, paprs, pplay, t_seri, q_seri, conv_q,2731 ! CALL conlmd (phys_tstep, paprs, pplay, t_seri, q_seri, conv_q, 2552 2732 ! . d_t_con, d_q_con, 2553 2733 ! . rain_con, snow_con, ibas_con, itop_con) 2554 2734 ELSE IF (iflag_con.EQ.2) THEN 2555 CALL conflx( dtime, paprs, pplay, t_seri, q_seri, &2735 CALL conflx(phys_tstep, paprs, pplay, t_seri, q_seri, & 2556 2736 conv_t, conv_q, -evap, omega, & 2557 2737 d_t_con, d_q_con, rain_con, snow_con, & … … 2629 2809 2630 2810 !jyg< 2631 CALL alpale( debut, itap, dtime, paprs, omega, t_seri, &2811 CALL alpale( debut, itap, phys_tstep, paprs, omega, t_seri, & 2632 2812 alp_offset, it_wape_prescr, wape_prescr, fip_prescr, & 2633 2813 ale_bl_prescr, alp_bl_prescr, & … … 2671 2851 !c CALL concvl (iflag_con,iflag_clos, 2672 2852 CALL concvl (iflag_clos, & 2673 dtime, paprs, pplay, k_upper_cv, t_x,q_x, &2853 phys_tstep, paprs, pplay, k_upper_cv, t_x,q_x, & 2674 2854 t_w,q_w,wake_s, & 2675 2855 u_seri,v_seri,tr_seri,nbtr_tmp, & … … 2679 2859 rain_con, snow_con, ibas_con, itop_con, sigd, & 2680 2860 ema_cbmf,plcl,plfc,wbeff,convoccur,upwd,dnwd,dnwd0, & 2681 Ma,mip ,Vprecip,cape,cin,tvp,Tconv,iflagctrl, &2861 Ma,mipsh,Vprecip,cape,cin,tvp,Tconv,iflagctrl, & 2682 2862 pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, & 2683 2863 ! RomP >>> 2684 2864 !! . pmflxr,pmflxs,da,phi,mp, 2685 2865 !! . ftd,fqd,lalim_conv,wght_th) 2686 pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij, clw,elij, &2866 pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,qtaa,clw,elij, & 2687 2867 ftd,fqd,lalim_conv,wght_th, & 2688 2868 ev, ep,epmlmMm,eplaMm, & 2689 wdtrainA, wdtrainM,wght_cvfd,qtc_cv,sigt_cv, &2869 wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv, & 2690 2870 tau_cld_cv,coefw_cld_cv,epmax_diag) 2691 2871 … … 2741 2921 DO k=1,klev 2742 2922 DO i=1,klon 2743 ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/ dtime2744 fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/ dtime2923 ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/phys_tstep 2924 fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/phys_tstep 2745 2925 d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k) 2746 2926 d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k) … … 2754 2934 2755 2935 ! MAF conema3 ne contient pas les traceurs 2756 CALL conema3 ( dtime, &2936 CALL conema3 (phys_tstep, & 2757 2937 paprs,pplay,t_seri,q_seri, & 2758 2938 u_seri,v_seri,tr_seri,ntra, & … … 2865 3045 CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, & 2866 3046 'convection',abortphy,flag_inhib_tend,itap,0) 2867 callprt_enerbil('convection',itap)3047 CALL prt_enerbil('convection',itap) 2868 3048 2869 3049 !------------------------------------------------------------------------- … … 2886 3066 snow_con(i))*cell_area(i)/REAL(klon) 2887 3067 ENDDO 2888 zx_t = zx_t/za* dtime3068 zx_t = zx_t/za*phys_tstep 2889 3069 WRITE(lunout,*)"Precip=", zx_t 2890 3070 ENDIF … … 2900 3080 ENDDO 2901 3081 DO i = 1, klon 2902 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))* dtime) &3082 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) & 2903 3083 /z_apres(i) 2904 3084 ENDDO … … 2937 3117 M_dwn(i,k) = dnwd0(i,k) 2938 3118 M_up(i,k) = upwd(i,k) 2939 dt_a(i,k) = d_t_con(i,k)/ dtime- ftd(i,k)2940 dq_a(i,k) = d_q_con(i,k)/ dtime- fqd(i,k)3119 dt_a(i,k) = d_t_con(i,k)/phys_tstep - ftd(i,k) 3120 dq_a(i,k) = d_q_con(i,k)/phys_tstep - fqd(i,k) 2941 3121 ENDDO 2942 3122 ENDDO … … 2946 3126 DO k = 1,klev 2947 3127 dt_dwn(:,k)= dt_dwn(:,k)+ & 2948 ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/ dtime3128 ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/phys_tstep 2949 3129 dq_dwn(:,k)= dq_dwn(:,k)+ & 2950 ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/ dtime3130 ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/phys_tstep 2951 3131 ENDDO 2952 3132 ELSEIF (iflag_wake==3) THEN … … 2959 3139 ! l'eau se reevapore). 2960 3140 dt_dwn(i,k)= dt_dwn(i,k)+ & 2961 ok_wk_lsp(i)*d_t_lsc(i,k)/ dtime3141 ok_wk_lsp(i)*d_t_lsc(i,k)/phys_tstep 2962 3142 dq_dwn(i,k)= dq_dwn(i,k)+ & 2963 ok_wk_lsp(i)*d_q_lsc(i,k)/ dtime3143 ok_wk_lsp(i)*d_q_lsc(i,k)/phys_tstep 2964 3144 ENDIF 2965 3145 ENDDO … … 2969 3149 ! 2970 3150 !calcul caracteristiques de la poche froide 2971 CALL calWAKE (iflag_wake_tend, paprs, pplay, dtime, &3151 CALL calWAKE (iflag_wake_tend, paprs, pplay, phys_tstep, & 2972 3152 t_seri, q_seri, omega, & 2973 3153 dt_dwn, dq_dwn, M_dwn, M_up, & … … 2996 3176 CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake', & 2997 3177 abortphy,flag_inhib_tend,itap,0) 2998 callprt_enerbil('wake',itap)3178 CALL prt_enerbil('wake',itap) 2999 3179 !------------------------------------------------------------------------ 3000 3180 … … 3005 3185 (d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_a_wk, d_dens_wk, wake_k, & 3006 3186 'wake', abortphy) 3007 callprt_enerbil('wake',itap)3187 CALL prt_enerbil('wake',itap) 3008 3188 ENDIF ! (iflag_wake_tend .GT. 0.) 3009 3189 ! … … 3016 3196 IF (iflag_alp_wk_cond .GT. 0.) THEN 3017 3197 3018 CALL alpale_wk( dtime, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, &3198 CALL alpale_wk(phys_tstep, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, & 3019 3199 wake_fip) 3020 3200 ELSE … … 3147 3327 (d_deltat_the, d_deltaq_the, dsig0, ddens0, ddens0, wake_k, 'the', abortphy) 3148 3328 ENDIF 3149 callprt_enerbil('the',itap)3329 CALL prt_enerbil('the',itap) 3150 3330 ! 3151 3331 ENDIF ! (mod(iflag_pbl_split/10,10) .GE. 1) … … 3153 3333 CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs, & 3154 3334 dql0,dqi0,paprs,'thermals', abortphy,flag_inhib_tend,itap,0) 3155 callprt_enerbil('thermals',itap)3335 CALL prt_enerbil('thermals',itap) 3156 3336 ! 3157 3337 ! 3158 CALL alpale_th( dtime, lmax_th, t_seri, cell_area, &3338 CALL alpale_th( phys_tstep, lmax_th, t_seri, cell_area, & 3159 3339 cin, s2, n2, & 3160 3340 ale_bl_trig, ale_bl_stat, ale_bl, & … … 3216 3396 CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs, & 3217 3397 'ajsb',abortphy,flag_inhib_tend,itap,0) 3218 callprt_enerbil('ajsb',itap)3398 CALL prt_enerbil('ajsb',itap) 3219 3399 d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:) 3220 3400 d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:) … … 3246 3426 ENDIF 3247 3427 ! 3248 CALL fisrtilp( dtime,paprs,pplay, &3428 CALL fisrtilp(phys_tstep,paprs,pplay, & 3249 3429 t_seri, q_seri,ptconv,ratqs, & 3250 3430 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, & … … 3267 3447 CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs, & 3268 3448 'lsc',abortphy,flag_inhib_tend,itap,0) 3269 callprt_enerbil('lsc',itap)3449 CALL prt_enerbil('lsc',itap) 3270 3450 rain_num(:)=0. 3271 3451 DO k = 1, klev … … 3306 3486 + snow_lsc(i))*cell_area(i)/REAL(klon) 3307 3487 ENDDO 3308 zx_t = zx_t/za* dtime3488 zx_t = zx_t/za*phys_tstep 3309 3489 WRITE(lunout,*)"Precip=", zx_t 3310 3490 ENDIF … … 3526 3706 calday = REAL(days_elapsed + 1) + jH_cur 3527 3707 3528 CALL chemtime(itap+itau_phy-1, date0, dtime, itap) 3529 IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN 3530 CALL AEROSOL_METEO_CALC( & 3531 calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, & 3532 prfl,psfl,pctsrf,cell_area, & 3533 latitude_deg,longitude_deg,u10m,v10m) 3534 ENDIF 3708 CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap) 3709 CALL AEROSOL_METEO_CALC( & 3710 calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, & 3711 prfl,psfl,pctsrf,cell_area, & 3712 latitude_deg,longitude_deg,u10m,v10m) 3535 3713 3536 3714 zxsnow_dummy(:) = 0.0 … … 3615 3793 #else 3616 3794 !--climatologies or INCA aerosols 3617 CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, &3795 CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, & 3618 3796 new_aod, flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, & 3619 3797 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & … … 3705 3883 CALL readaerosolstrato1_rrtm(debut) 3706 3884 ELSEIF (flag_aerosol_strat.EQ.2) THEN 3707 CALL readaerosolstrato2_rrtm(debut )3885 CALL readaerosolstrato2_rrtm(debut, ok_volcan) 3708 3886 ELSE 3709 3887 abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1' … … 3717 3895 #endif 3718 3896 ENDIF 3897 ELSE 3898 tausum_aero(:,:,id_STRAT_phy) = 0. 3719 3899 ENDIF 3720 3900 ! … … 3895 4075 RCFC11 = RCFC11_act 3896 4076 RCFC12 = RCFC12_act 4077 ! 4078 !--interactive CO2 in ppm from carbon cycle 4079 IF (carbon_cycle_rad.AND..NOT.debut) THEN 4080 RCO2=RCO2_glo 4081 ENDIF 3897 4082 ! 3898 4083 IF (prt_level .GE.10) THEN 3899 4084 print *,' ->radlwsw, number 1 ' 3900 4085 ENDIF 3901 3902 4086 ! 3903 4087 CALL radlwsw & … … 3909 4093 t_seri,q_seri,wo, & 3910 4094 cldfrarad, cldemirad, cldtaurad, & 3911 ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, flag_aerosol, & 4095 ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, & 4096 flag_aerosol, & 3912 4097 flag_aerosol_strat, flag_aer_feedback, & 3913 4098 tau_aero, piz_aero, cg_aero, & … … 3920 4105 ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & 3921 4106 heat,heat0,cool,cool0,albpla, & 4107 heat_volc,cool_volc, & 3922 4108 topsw,toplw,solsw,sollw, & 3923 4109 sollwdown, & … … 3994 4180 t_seri,q_seri,wo, & 3995 4181 cldfrarad, cldemirad, cldtaurad, & 3996 ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, flag_aerosol, & 4182 ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, ok_volcan, & 4183 flag_aerosol, & 3997 4184 flag_aerosol_strat, flag_aer_feedback, & 3998 4185 tau_aero, piz_aero, cg_aero, & … … 4005 4192 ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, & 4006 4193 heatp,heat0p,coolp,cool0p,albplap, & 4194 heat_volc,cool_volc, & 4007 4195 topswp,toplwp,solswp,sollwp, & 4008 4196 sollwdownp, & … … 4072 4260 4073 4261 DO k=1, klev 4074 d_t_swr(:,k)=swradcorr(:)*heat(:,k)* dtime/RDAY4075 d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)* dtime/RDAY4076 d_t_lwr(:,k)=-cool(:,k)* dtime/RDAY4077 d_t_lw0(:,k)=-cool0(:,k)* dtime/RDAY4262 d_t_swr(:,k)=swradcorr(:)*heat(:,k)*phys_tstep/RDAY 4263 d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)*phys_tstep/RDAY 4264 d_t_lwr(:,k)=-cool(:,k)*phys_tstep/RDAY 4265 d_t_lw0(:,k)=-cool0(:,k)*phys_tstep/RDAY 4078 4266 ENDDO 4079 4267 4080 4268 CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy,flag_inhib_tend,itap,0) 4081 callprt_enerbil('SW',itap)4269 CALL prt_enerbil('SW',itap) 4082 4270 CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy,flag_inhib_tend,itap,0) 4083 callprt_enerbil('LW',itap)4271 CALL prt_enerbil('LW',itap) 4084 4272 4085 4273 ! … … 4131 4319 IF (ok_strato) THEN 4132 4320 4133 CALL drag_noro_strato(0,klon,klev, dtime,paprs,pplay, &4321 CALL drag_noro_strato(0,klon,klev,phys_tstep,paprs,pplay, & 4134 4322 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 4135 4323 igwd,idx,itest, & … … 4139 4327 4140 4328 ELSE 4141 CALL drag_noro(klon,klev, dtime,paprs,pplay, &4329 CALL drag_noro(klon,klev,phys_tstep,paprs,pplay, & 4142 4330 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 4143 4331 igwd,idx,itest, & … … 4152 4340 CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro', & 4153 4341 abortphy,flag_inhib_tend,itap,0) 4154 callprt_enerbil('oro',itap)4342 CALL prt_enerbil('oro',itap) 4155 4343 !---------------------------------------------------------------------- 4156 4344 ! … … 4180 4368 IF (ok_strato) THEN 4181 4369 4182 CALL lift_noro_strato(klon,klev, dtime,paprs,pplay, &4370 CALL lift_noro_strato(klon,klev,phys_tstep,paprs,pplay, & 4183 4371 latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, & 4184 4372 igwd,idx,itest, & … … 4188 4376 4189 4377 ELSE 4190 CALL lift_noro(klon,klev, dtime,paprs,pplay, &4378 CALL lift_noro(klon,klev,phys_tstep,paprs,pplay, & 4191 4379 latitude_deg,zmea,zstd,zpic, & 4192 4380 itest, & … … 4199 4387 CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, paprs, & 4200 4388 'lif', abortphy,flag_inhib_tend,itap,0) 4201 callprt_enerbil('lif',itap)4389 CALL prt_enerbil('lif',itap) 4202 4390 ENDIF ! fin de test sur ok_orolf 4203 4391 … … 4208 4396 du_gwd_hines=0. 4209 4397 dv_gwd_hines=0. 4210 CALL hines_gwd(klon, klev, dtime, paprs, pplay, latitude_deg, t_seri, &4398 CALL hines_gwd(klon, klev, phys_tstep, paprs, pplay, latitude_deg, t_seri, & 4211 4399 u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, & 4212 4400 du_gwd_hines, dv_gwd_hines) … … 4214 4402 zvstr_gwd_hines=0. 4215 4403 DO k = 1, klev 4216 zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/ dtime&4404 zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/phys_tstep & 4217 4405 * (paprs(:, k)-paprs(:, k+1))/rg 4218 zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/ dtime&4406 zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/phys_tstep & 4219 4407 * (paprs(:, k)-paprs(:, k+1))/rg 4220 4408 ENDDO … … 4223 4411 CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, & 4224 4412 dqi0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0) 4225 callprt_enerbil('hin',itap)4413 CALL prt_enerbil('hin',itap) 4226 4414 ENDIF 4227 4415 4228 4416 IF (.not. ok_hines .and. ok_gwd_rando) then 4229 CALL acama_GWD_rando(DTIME, pplay, latitude_deg, t_seri, u_seri, & 4417 ! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod 4418 CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, & 4230 4419 v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, & 4231 4420 dv_gwd_front, east_gwstress, west_gwstress) … … 4233 4422 zvstr_gwd_front=0. 4234 4423 DO k = 1, klev 4235 zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/ dtime&4424 zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/phys_tstep & 4236 4425 * (paprs(:, k)-paprs(:, k+1))/rg 4237 zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/ dtime&4426 zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/phys_tstep & 4238 4427 * (paprs(:, k)-paprs(:, k+1))/rg 4239 4428 ENDDO … … 4241 4430 CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, & 4242 4431 paprs, 'front_gwd_rando', abortphy,flag_inhib_tend,itap,0) 4243 callprt_enerbil('front_gwd_rando',itap)4432 CALL prt_enerbil('front_gwd_rando',itap) 4244 4433 ENDIF 4245 4434 4246 4435 IF (ok_gwd_rando) THEN 4247 CALL FLOTT_GWD_rando( DTIME, pplay, t_seri, u_seri, v_seri, &4436 CALL FLOTT_GWD_rando(PHYS_TSTEP, pplay, t_seri, u_seri, v_seri, & 4248 4437 rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, & 4249 4438 du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress) 4250 4439 CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, & 4251 4440 paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend,itap,0) 4252 callprt_enerbil('flott_gwd_rando',itap)4441 CALL prt_enerbil('flott_gwd_rando',itap) 4253 4442 zustr_gwd_rando=0. 4254 4443 zvstr_gwd_rando=0. 4255 4444 DO k = 1, klev 4256 zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/ dtime&4445 zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/phys_tstep & 4257 4446 * (paprs(:, k)-paprs(:, k+1))/rg 4258 zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/ dtime&4447 zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/phys_tstep & 4259 4448 * (paprs(:, k)-paprs(:, k+1))/rg 4260 4449 ENDDO … … 4276 4465 DO k = 1, klev 4277 4466 DO i = 1, klon 4278 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/ dtime* &4467 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/phys_tstep* & 4279 4468 (paprs(i,k)-paprs(i,k+1))/rg 4280 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/ dtime* &4469 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/phys_tstep* & 4281 4470 (paprs(i,k)-paprs(i,k+1))/rg 4282 4471 ENDDO … … 4296 4485 !IM cf. FLott END 4297 4486 !DC Calcul de la tendance due au methane 4298 IF (ok_qch4) THEN4487 IF (ok_qch4) THEN 4299 4488 CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay) 4300 4489 ! ajout de la tendance d'humidite due au methane 4301 d_q_ch4_dtime(:,:) = d_q_ch4(:,:)* dtime4490 d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep 4302 4491 CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, paprs, & 4303 4492 'q_ch4', abortphy,flag_inhib_tend,itap,0) 4304 d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/ dtime4493 d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/phys_tstep 4305 4494 ENDIF 4306 4495 ! … … 4313 4502 ! Inititialization 4314 4503 !------------------ 4315 4316 4317 4504 4318 4505 addtkeoro=0 … … 4326 4513 alphatkeoro=min(max(0.,alphatkeoro),1.) 4327 4514 4328 smallscales_tkeoro=. false.4515 smallscales_tkeoro=.FALSE. 4329 4516 CALL getin_p('smallscales_tkeoro',smallscales_tkeoro) 4330 4517 4331 4518 4332 dtadd(:,:)=0. 4333 duadd(:,:)=0. 4334 dvadd(:,:)=0. 4335 4336 4519 dtadd(:,:)=0. 4520 duadd(:,:)=0. 4521 dvadd(:,:)=0. 4337 4522 4338 4523 ! Choices for addtkeoro: … … 4349 4534 4350 4535 4351 4352 4536 IF (addtkeoro .EQ. 1 ) THEN 4353 4537 … … 4357 4541 ELSE IF (addtkeoro .EQ. 2) THEN 4358 4542 4359 4360 4361 IF (smallscales_tkeoro) THEN 4543 IF (smallscales_tkeoro) THEN 4362 4544 igwd=0 4363 4545 DO i=1,klon … … 4382 4564 igwd=igwd+1 4383 4565 idx(igwd)=i 4384 ENDIF 4385 ENDDO 4386 4387 END IF 4388 4389 4390 4391 4392 CALL drag_noro_strato(addtkeoro,klon,klev,dtime,paprs,pplay, & 4566 ENDIF 4567 ENDDO 4568 4569 ENDIF 4570 4571 CALL drag_noro_strato(addtkeoro,klon,klev,phys_tstep,paprs,pplay, & 4393 4572 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 4394 4573 igwd,idx,itest, & … … 4397 4576 d_t_oro_gw, d_u_oro_gw, d_v_oro_gw) 4398 4577 4399 zustrdr(:)=0. 4400 zvstrdr(:)=0. 4401 zulow(:)=0. 4402 zvlow(:)=0. 4403 4404 duadd(:,:)=alphatkeoro*d_u_oro_gw(:,:) 4405 dvadd(:,:)=alphatkeoro*d_v_oro_gw(:,:) 4406 END IF 4407 4578 zustrdr(:)=0. 4579 zvstrdr(:)=0. 4580 zulow(:)=0. 4581 zvlow(:)=0. 4582 4583 duadd(:,:)=alphatkeoro*d_u_oro_gw(:,:) 4584 dvadd(:,:)=alphatkeoro*d_v_oro_gw(:,:) 4585 ENDIF 4408 4586 4409 4587 … … 4416 4594 4417 4595 4418 4419 4596 ENDIF 4420 4597 ! ----- 4421 4598 !=============================================================== 4422 4423 4599 4424 4600 … … 4431 4607 ! adeclarer 4432 4608 #ifdef CPP_COSP 4433 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/ dtime)).EQ.0) THEN4609 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN 4434 4610 4435 4611 IF (prt_level .GE.10) THEN … … 4439 4615 ! print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=', 4440 4616 ! s ref_liq,ref_ice 4441 CALL phys_cosp(itap, dtime,freq_cosp, &4617 CALL phys_cosp(itap,phys_tstep,freq_cosp, & 4442 4618 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 4443 4619 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & … … 4462 4638 4463 4639 #ifdef CPP_COSP2 4464 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/ dtime)).EQ.0) THEN4640 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN 4465 4641 4466 4642 IF (prt_level .GE.10) THEN … … 4470 4646 print*,'Dans physiq.F avant appel ' 4471 4647 ! s ref_liq,ref_ice 4472 CALL phys_cosp2(itap, dtime,freq_cosp, &4648 CALL phys_cosp2(itap,phys_tstep,freq_cosp, & 4473 4649 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 4474 4650 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & … … 4485 4661 #endif 4486 4662 4663 #ifdef CPP_COSPV2 4664 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN 4665 4666 IF (prt_level .GE.10) THEN 4667 print*,'freq_cosp',freq_cosp 4668 ENDIF 4669 mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse 4670 print*,'Dans physiq.F avant appel ' 4671 ! s ref_liq,ref_ice 4672 CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, & 4673 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 4674 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & 4675 klon,klev,longitude_deg,latitude_deg,presnivs,overlap, & 4676 JrNt,ref_liq,ref_ice, & 4677 pctsrf(:,is_ter)+pctsrf(:,is_lic), & 4678 zu10m,zv10m,pphis, & 4679 zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, & 4680 qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, & 4681 prfl(:,1:klev),psfl(:,1:klev), & 4682 pmflxr(:,1:klev),pmflxs(:,1:klev), & 4683 mr_ozone,cldtau, cldemi) 4684 ENDIF 4685 #endif 4686 4487 4687 ENDIF !ok_cosp 4488 4688 … … 4492 4692 IF (ok_airs) then 4493 4693 4494 IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/ dtime)).EQ.0) THEN4694 IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/phys_tstep)).EQ.0) THEN 4495 4695 write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs 4496 4696 CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,& … … 4547 4747 CALL phytrac ( & 4548 4748 itap, days_elapsed+1, jH_cur, debut, & 4549 lafin, dtime, u, v, t, &4749 lafin, phys_tstep, u, v, t, & 4550 4750 paprs, pplay, pmfu, pmfd, & 4551 4751 pen_u, pde_u, pen_d, pde_d, & … … 4582 4782 cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, & 4583 4783 frac_impa, frac_nucl, & 4584 pphis,cell_area, dtime,itap, &4784 pphis,cell_area,phys_tstep,itap, & 4585 4785 qx(:,:,ivap),da,phi,mp,upwd,dnwd) 4586 4786 … … 4653 4853 4654 4854 CALL chemhook_end ( & 4655 dtime, &4855 phys_tstep, & 4656 4856 pplay, & 4657 4857 t_seri, & … … 4688 4888 DO k = 1, klev 4689 4889 DO i = 1, klon 4690 d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime4691 d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime4692 d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime4693 d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime4694 d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime4890 d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / phys_tstep 4891 d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / phys_tstep 4892 d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / phys_tstep 4893 d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / phys_tstep 4894 d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep 4695 4895 !CR: on ajoute le contenu en glace 4696 4896 IF (nqo.eq.3) THEN 4697 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / dtime4897 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep 4698 4898 ENDIF 4699 4899 ENDDO … … 4707 4907 DO k = 1, klev 4708 4908 DO i = 1, klon 4709 ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime4710 d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / dtime4909 ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / phys_tstep 4910 d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / phys_tstep 4711 4911 ENDDO 4712 4912 ENDDO … … 4877 5077 CALL phys_output_write(itap, pdtphys, paprs, pphis, & 4878 5078 pplay, lmax_th, aerosol_couple, & 4879 ok_ade, ok_aie, ivap, iliq, isol, new_aod, &5079 ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, new_aod, & 4880 5080 ok_sync, ptconv, read_climoz, clevSTD, & 4881 5081 ptconvth, d_u, d_t, qx, d_qx, zmasse, & … … 4890 5090 4891 5091 ! On remet des variables a .false. apres un premier appel 4892 if (debut) then5092 IF (debut) THEN 4893 5093 #ifdef CPP_XIOS 4894 5094 swaero_diag=.FALSE. … … 4898 5098 ! write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm 4899 5099 4900 IF (is_master) then5100 IF (is_master) THEN 4901 5101 !--setting up swaero_diag to TRUE in XIOS case 4902 5102 IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. & … … 4929 5129 xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) & 4930 5130 ok_4xCO2atm=.TRUE. 4931 endif5131 ENDIF 4932 5132 !$OMP BARRIER 4933 callbcast(swaero_diag)4934 callbcast(swaerofree_diag)4935 callbcast(dryaod_diag)4936 callbcast(ok_4xCO2atm)5133 CALL bcast(swaero_diag) 5134 CALL bcast(swaerofree_diag) 5135 CALL bcast(dryaod_diag) 5136 CALL bcast(ok_4xCO2atm) 4937 5137 ! write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm 4938 5138 #endif 4939 endif5139 ENDIF 4940 5140 4941 5141 !==================================================================== … … 4962 5162 ! write(97) u_seri,v_seri,t_seri,q_seri 4963 5163 ! close(97) 4964 !$OMP MASTER 4965 IF (read_climoz >= 1) THEN 4966 IF (is_mpi_root) THEN 4967 CALL nf95_close(ncid_climoz) 4968 ENDIF 4969 DEALLOCATE(press_edg_climoz) ! pointer 4970 DEALLOCATE(press_cen_climoz) ! pointer 4971 ENDIF 4972 !$OMP END MASTER 4973 print *,' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1 5164 5165 IF (is_omp_master) THEN 5166 5167 IF (read_climoz >= 1) THEN 5168 IF (is_mpi_root) CALL nf95_close(ncid_climoz) 5169 DEALLOCATE(press_edg_climoz) ! pointer 5170 DEALLOCATE(press_cen_climoz) ! pointer 5171 ENDIF 5172 5173 ENDIF 5174 #ifdef CPP_XIOS 5175 IF (is_omp_master) CALL xios_context_finalize 5176 #endif 5177 WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1 4974 5178 ENDIF 4975 5179 4976 5180 ! first=.false. 4977 5181 4978 4979 5182 END SUBROUTINE physiq 4980 5183
Note: See TracChangeset
for help on using the changeset viewer.
