Changeset 4369 for LMDZ6/branches/Ocean_skin/libf
- Timestamp:
- Dec 6, 2022, 1:01:47 PM (2 years ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 9 edited
- 3 copied
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
- Property svn:mergeinfo changed
/LMDZ6/trunk merged: 4367
- Property svn:mergeinfo changed
-
LMDZ6/branches/Ocean_skin/libf/dyn3d/check_isotopes.F90
r4368 r4369 11 11 INTEGER :: ixt, ipha, k, i, iq, iiso, izon, ieau, iqeau, iqpar 12 12 INTEGER, ALLOCATABLE :: ix(:) 13 REAL, ALLOCATABLE :: tnat(:)13 REAL, ALLOCATABLE, SAVE :: tnat(:) 14 14 REAL :: xtractot, xiiso, deltaD, q1, q2 15 15 REAL, PARAMETER :: borne = 1e19, & -
LMDZ6/branches/Ocean_skin/libf/dyn3dmem/check_isotopes_loc.F90
r4368 r4369 12 12 INTEGER :: ixt, ipha, k, i, iq, iiso, izon, ieau, iqeau, iqpar 13 13 INTEGER, ALLOCATABLE :: ix(:) 14 REAL, ALLOCATABLE :: tnat(:)!--- OpenMP shared variable14 REAL, ALLOCATABLE, SAVE :: tnat(:) !--- OpenMP shared variable 15 15 REAL :: xtractot, xiiso, deltaD, q1, q2 16 16 REAL, PARAMETER :: borne = 1e19, & -
LMDZ6/branches/Ocean_skin/libf/misc/readTracFiles_mod.f90
r4368 r4369 1306 1306 RETURN 1307 1307 END IF 1308 iky = 0; IF(ALLOCATED(ky%key)) iky =strIdx(ky%key,key)1308 iky = strIdx(ky%key,key) 1309 1309 IF(iky == 0) THEN 1310 nky = 0; IF(ALLOCATED(ky%key)) nky =SIZE(ky%key)1310 nky = SIZE(ky%key) 1311 1311 ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k 1312 1312 ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = val; ky%val = v -
LMDZ6/branches/Ocean_skin/libf/phylmd/phyetat0_mod.F90
r4368 r4369 4 4 5 5 PRIVATE 6 PUBLIC :: phyetat0, phyetat0_get, phyetat0_srf 7 8 INTERFACE phyetat0_get 9 MODULE PROCEDURE phyetat0_get10, phyetat0_get20, phyetat0_get11, phyetat0_get21 10 END INTERFACE phyetat0_get 11 INTERFACE phyetat0_srf 12 MODULE PROCEDURE phyetat0_srf20, phyetat0_srf30, phyetat0_srf21, phyetat0_srf31 13 END INTERFACE phyetat0_srf 6 PUBLIC :: phyetat0 14 7 15 8 CONTAINS … … 23 16 USE pbl_surface_mod, ONLY : pbl_surface_init 24 17 USE surface_data, ONLY : type_ocean, version_ocean 18 USE phyetat0_get_mod, ONLY : phyetat0_get, phyetat0_srf 25 19 USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, phys_tstep, & 26 20 qsol, fevap, z0m, z0h, agesno, & … … 611 605 END SUBROUTINE phyetat0 612 606 613 !==============================================================================614 LOGICAL FUNCTION phyetat0_get10(field, name, descr, default) RESULT(lFound)615 ! Read a field. Check whether reading succeded and use default value if not.616 IMPLICIT NONE617 REAL, INTENT(INOUT) :: field(:) ! klon618 CHARACTER(LEN=*), INTENT(IN) :: name619 CHARACTER(LEN=*), INTENT(IN) :: descr620 REAL, INTENT(IN) :: default621 !------------------------------------------------------------------------------622 REAL :: fld(SIZE(field),1)623 lFound = phyetat0_get21(fld, [name], descr, default); field = fld(:,1)624 END FUNCTION phyetat0_get10625 !==============================================================================626 LOGICAL FUNCTION phyetat0_get20(field, name, descr, default) RESULT(lFound)627 ! Same as phyetat0_get11, field on multiple levels.628 IMPLICIT NONE629 REAL, INTENT(INOUT) :: field(:,:) ! klon, nlev630 CHARACTER(LEN=*), INTENT(IN) :: name631 CHARACTER(LEN=*), INTENT(IN) :: descr632 REAL, INTENT(IN) :: default633 !-----------------------------------------------------------------------------634 lFound = phyetat0_get21(field, [name], descr, default)635 END FUNCTION phyetat0_get20636 !==============================================================================637 LOGICAL FUNCTION phyetat0_get11(field, name, descr, default) RESULT(lFound)638 ! Same as phyetat0_get11, multiple names.639 IMPLICIT NONE640 REAL, INTENT(INOUT) :: field(:) ! klon641 CHARACTER(LEN=*), INTENT(IN) :: name(:)642 CHARACTER(LEN=*), INTENT(IN) :: descr643 REAL, INTENT(IN) :: default644 !-----------------------------------------------------------------------------645 REAL :: fld(SIZE(field),1)646 lFound = phyetat0_get21(fld, name, descr, default); field = fld(:,1)647 END FUNCTION phyetat0_get11648 !==============================================================================649 LOGICAL FUNCTION phyetat0_get21(field, name, descr, default, tname) RESULT(lFound)650 ! Same as phyetat0_get11, field on multiple levels, multiple names.651 USE iostart, ONLY: get_field652 USE print_control_mod, ONLY: lunout653 IMPLICIT NONE654 REAL, INTENT(INOUT) :: field(:,:) ! klon, nlev655 CHARACTER(LEN=*), INTENT(IN) :: name(:)656 CHARACTER(LEN=*), INTENT(IN) :: descr657 REAL, INTENT(IN) :: default658 CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: tname659 !-----------------------------------------------------------------------------660 CHARACTER(LEN=LEN(name)) :: tnam661 INTEGER :: i662 DO i = 1, SIZE(name)663 CALL get_field(TRIM(name(i)), field, lFound)664 IF(lFound) EXIT665 WRITE(lunout,*) "phyetat0: Missing field <",TRIM(name(i)),"> "666 END DO667 IF(.NOT.lFound) THEN668 WRITE(lunout,*) "Slightly distorted start ; continuing."669 field(:,:) = default670 tnam = name(1)671 ELSE672 tnam = name(i)673 END IF674 WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tnam)//' ('//TRIM(descr)//') min/max=', &675 MINval(field),' ',MAXval(field)676 IF(PRESENT(tname)) tname = tnam677 END FUNCTION phyetat0_get21678 !==============================================================================679 LOGICAL FUNCTION phyetat0_srf20(field, name, descr, default) RESULT(lFound)680 ! Read a field per sub-surface.681 ! Check whether reading succeded and use default value if not.682 IMPLICIT NONE683 REAL, INTENT(INOUT) :: field(:,:)684 CHARACTER(LEN=*), INTENT(IN) :: name685 CHARACTER(LEN=*), INTENT(IN) :: descr686 REAL, INTENT(IN) :: default687 !-----------------------------------------------------------------------------688 REAL :: fld(SIZE(field,1),1,SIZE(field,2))689 lFound = phyetat0_srf31(fld, [name], descr, default); field = fld(:,1,:)690 END FUNCTION phyetat0_srf20691 692 !==============================================================================693 LOGICAL FUNCTION phyetat0_srf30(field, name, descr, default) RESULT(lFound)694 ! Same as phyetat0_sfr11, multiple names tested one after the other.695 IMPLICIT NONE696 REAL, INTENT(INOUT) :: field(:,:,:)697 CHARACTER(LEN=*), INTENT(IN) :: name698 CHARACTER(LEN=*), INTENT(IN) :: descr699 REAL, INTENT(IN) :: default700 !-----------------------------------------------------------------------------701 lFound = phyetat0_srf31(field, [name], descr, default)702 END FUNCTION phyetat0_srf30703 704 !==============================================================================705 LOGICAL FUNCTION phyetat0_srf21(field, name, descr, default) RESULT(lFound)706 ! Same as phyetat0_sfr11, field on multiple levels.707 IMPLICIT NONE708 REAL, INTENT(INOUT) :: field(:,:)709 CHARACTER(LEN=*), INTENT(IN) :: name(:)710 CHARACTER(LEN=*), INTENT(IN) :: descr711 REAL, INTENT(IN) :: default712 !-----------------------------------------------------------------------------713 REAL :: fld(SIZE(field,1),1,SIZE(field,2))714 lFound = phyetat0_srf31(fld, name, descr, default); field = fld(:,1,:)715 END FUNCTION phyetat0_srf21716 717 !==============================================================================718 LOGICAL FUNCTION phyetat0_srf31(field, name, descr, default) RESULT(lFound)719 ! Same as phyetat0_sfr11, field on multiple levels, multiple names tested one after the other.720 USE iostart, ONLY: get_field721 USE print_control_mod, ONLY: lunout722 USE strings_mod, ONLY: int2str, maxlen723 IMPLICIT NONE724 REAL, INTENT(INOUT) :: field(:,:,:)725 CHARACTER(LEN=*), INTENT(IN) :: name(:)726 CHARACTER(LEN=*), INTENT(IN) :: descr727 REAL, INTENT(IN) :: default728 !-----------------------------------------------------------------------------729 INTEGER :: nsrf, i730 CHARACTER(LEN=maxlen) :: nam(SIZE(name)), tname, des731 IF(SIZE(field,3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1)732 DO nsrf = 1, SIZE(field,3)733 DO i = 1, SIZE(name); nam(i) = TRIM(name(i))//TRIM(int2str(nsrf,2)); END DO734 des = TRIM(descr)//" srf:"//int2str(nsrf,2)735 lFound = phyetat0_get21(field(:,:,nsrf), nam, TRIM(des), default, tname)736 END DO737 WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tname)//' ('//TRIM(descr)//') min/max=', &738 MINval(field),' ',MAXval(field)739 END FUNCTION phyetat0_srf31740 741 607 END MODULE phyetat0_mod 742 608 -
LMDZ6/branches/Ocean_skin/libf/phylmd/physiq_mod.F90
r4368 r4369 34 34 USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando 35 35 USE fonte_neige_mod, ONLY : fonte_neige_get_vars 36 USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg, longitude,latitude, & 37 boundslon,boundslat, dx, dy, ind_cell_glo 36 USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg 38 37 USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, & 39 38 histwrite, ju2ymds, ymds2ju, getin 40 39 USE ioipsl_getin_p_mod, ONLY : getin_p 41 40 USE indice_sol_mod 42 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac , nqCO241 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac 43 42 USE readTracFiles_mod, ONLY: addPhase 44 43 USE strings_mod, ONLY: strIdx … … 70 69 USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz 71 70 USE regr_pr_time_av_m, only: regr_pr_time_av 72 USE surface_data, ONLY : type_ocean, ok_veget, landice_opt 73 USE time_phylmdz_mod, only: annee_ref, current_time, day_ini, day_ref, & 74 day_step_phy, itau_phy, pdtphys, raz_date, start_time, update_time, ndays 71 USE surface_data, ONLY : type_ocean, ok_veget 72 USE time_phylmdz_mod, only: current_time, itau_phy, pdtphys, raz_date, update_time 75 73 USE tracinca_mod, ONLY: config_inca 76 74 USE tropopause_m, ONLY: dyn_tropopause 77 75 USE ice_sursat_mod, ONLY: flight_init, airplane 78 76 USE vampir 79 USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp80 77 USE write_field_phy 81 78 #ifdef CPP_XIOS … … 102 99 103 100 101 #ifdef INCA 102 USE geometry_mod, ONLY: longitude, latitude, boundslon, boundslat, ind_cell_glo 103 USE time_phylmdz_mod, ONLY: ndays 104 USE infotrac_phy, ONLY: nqCO2 105 #endif 104 106 #ifdef REPROBUS 105 USE CHEM_REP, ONLY : Init_chem_rep_xjour, & 106 d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, & 107 ztrop, gravit,itroprep, Z1,Z2,fac,B 107 USE chem_rep, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, & 108 ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B 109 #endif 110 #if defined INCA || defined REPROBUS 111 USE time_phylmdz_mod, ONLY: annee_ref, day_ini, day_ref, start_time 112 USE vertical_layers_mod, ONLY: aps, bps, ap, bp 108 113 #endif 109 114 … … 111 116 #ifdef CPP_RRTM 112 117 USE YOERAD, ONLY : NRADLP 113 USE YOESW, ONLY : RSUN118 ! USE YOESW, ONLY : RSUN 114 119 #endif 115 120 … … 147 152 d_t_ajsb,d_q_ajsb, & 148 153 d_t_ajs,d_q_ajs,d_u_ajs,d_v_ajs, & 149 d_t_ajs_w,d_q_ajs_w, &150 d_t_ajs_x,d_q_ajs_x, &154 ! d_t_ajs_w,d_q_ajs_w, & 155 ! d_t_ajs_x,d_q_ajs_x, & 151 156 ! 152 157 d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, & … … 161 166 d_ts, & 162 167 ! 163 d_t_oli,d_u_oli,d_v_oli, &168 ! d_t_oli,d_u_oli,d_v_oli, & 164 169 d_t_oro,d_u_oro,d_v_oro, & 165 170 d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, & … … 492 497 REAL dtadd(klon,klev) 493 498 494 !#ifdef CPP_XIOS495 ! TYPE(xios_context), SAVE :: g_ctx496 !#endif497 498 499 #ifndef CPP_XIOS 499 500 REAL, SAVE :: missing_val=nf90_fill_real … … 522 523 ! 523 524 ! 524 INTEGER debug525 525 INTEGER n 526 526 !ym INTEGER npoints … … 579 579 ! Upmost level reached by deep convection and related variable (jyg) 580 580 ! 581 INTEGER izero581 ! INTEGER izero 582 582 INTEGER k_upper_cv 583 583 !------------------------------------------------------------------ … … 749 749 REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt) 750 750 ! RomP <<< 751 REAL :: calday752 751 753 752 !IM cf FH pour Tiedtke 080604 … … 846 845 REAL conv_t(klon,klev) ! convergence de la temperature(K/s) 847 846 ! 848 #ifdef INCA849 REAL zxsnow_dummy(klon)850 #endif851 847 REAL zsav_tsol(klon) 852 848 ! … … 863 859 real zqsat(klon,klev) 864 860 ! 865 INTEGER i, k, iq, j, nsrf, ll, l, itr861 INTEGER i, k, iq, nsrf, l, itr 866 862 ! 867 863 REAL t_coup … … 1179 1175 1180 1176 #ifdef INCA 1177 REAL :: calday, zxsnow_dummy(klon) 1181 1178 ! set de variables utilisees pour l'initialisation des valeurs provenant de INCA 1182 1179 REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_tauinca … … 1225 1222 #ifdef CPP_XIOS 1226 1223 ! switch to XIOS LMDZ physics context 1227 !!!!$OMP MASTER1228 !!!! WRITE(*,*)'PHYSICS XIOS Context :', g_ctx1229 !!!! CALL wxios_set_context()1230 !!!!$OMP END MASTER1231 1224 IF (.NOT. debut .AND. is_omp_master) THEN 1232 1225 CALL wxios_set_context() … … 1302 1295 CALL strataer_init 1303 1296 #endif 1304 1305 !!CALL flight_init1306 1297 1307 1298 print*, '=================================================' … … 2221 2212 ENDIF 2222 2213 ENDIF 2223 ! switch to XIOS LMDZ physics context just in case2224 !$OMP MASTER2225 !!!!#ifdef CPP_XIOS2226 !!!! WRITE(*,*)'PHYSICS XIOS Context :', g_ctx2227 !!!! CALL xios_set_current_context(g_ctx)2228 !!!!#endif2229 !$OMP END MASTER2230 2231 2214 ! 2232 2215 ! … … 5189 5172 ENDDO 5190 5173 ! 5191 IF (nqtot > nqo) THEN 5192 itr = 0 5193 DO iq = 1, nqtot 5194 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 5195 itr = itr+1 5196 DO k = 1, klev 5197 DO i = 1, klon 5198 d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / phys_tstep 5199 ENDDO 5174 ! DC: All iterations are cycled if nqtot==nqo, so no nqtot>nqo condition required 5175 itr = 0 5176 DO iq = 1, nqtot 5177 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 5178 itr = itr+1 5179 DO k = 1, klev 5180 DO i = 1, klon 5181 d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / phys_tstep 5200 5182 ENDDO 5201 5183 ENDDO 5202 END IF5184 ENDDO 5203 5185 ! 5204 5186 !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano -
LMDZ6/branches/Ocean_skin/libf/phylmdiso/isotopes_routines_mod.F90
r4368 r4369 16518 16518 USE indice_sol_mod, ONLY: nbsrf 16519 16519 USE isotopes_mod, ONLY: isoName,iso_HDO,iso_eau 16520 USE phyetat0_ mod,ONLY: phyetat0_get, phyetat0_srf16520 USE phyetat0_get_mod, ONLY: phyetat0_get, phyetat0_srf 16521 16521 USE readTracFiles_mod, ONLY: new2oldH2O 16522 16522 USE strings_mod, ONLY: strIdx, strHead, strTail, maxlen, msg, int2str -
LMDZ6/branches/Ocean_skin/libf/phylmdiso/phyetat0_mod.F90
r4368 r4369 4 4 5 5 PRIVATE 6 PUBLIC :: phyetat0, phyetat0_get, phyetat0_srf 7 8 INTERFACE phyetat0_get 9 MODULE PROCEDURE phyetat0_get10, phyetat0_get20, phyetat0_get11, phyetat0_get21 10 END INTERFACE phyetat0_get 11 INTERFACE phyetat0_srf 12 MODULE PROCEDURE phyetat0_srf20, phyetat0_srf30, phyetat0_srf21, phyetat0_srf31 13 END INTERFACE phyetat0_srf 6 PUBLIC :: phyetat0 14 7 15 8 CONTAINS … … 26 19 USE pbl_surface_mod, ONLY : pbl_surface_init_iso 27 20 #endif 21 USE phyetat0_get_mod, ONLY : phyetat0_get, phyetat0_srf 28 22 USE surface_data, ONLY : type_ocean, version_ocean 29 23 USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, phys_tstep, & … … 649 643 END SUBROUTINE phyetat0 650 644 651 !==============================================================================652 LOGICAL FUNCTION phyetat0_get10(field, name, descr, default) RESULT(lFound)653 ! Read a field. Check whether reading succeded and use default value if not.654 IMPLICIT NONE655 REAL, INTENT(INOUT) :: field(:) ! klon656 CHARACTER(LEN=*), INTENT(IN) :: name657 CHARACTER(LEN=*), INTENT(IN) :: descr658 REAL, INTENT(IN) :: default659 !------------------------------------------------------------------------------660 REAL :: fld(SIZE(field),1)661 lFound = phyetat0_get21(fld, [name], descr, default); field = fld(:,1)662 END FUNCTION phyetat0_get10663 !==============================================================================664 LOGICAL FUNCTION phyetat0_get20(field, name, descr, default) RESULT(lFound)665 ! Same as phyetat0_get11, field on multiple levels.666 IMPLICIT NONE667 REAL, INTENT(INOUT) :: field(:,:) ! klon, nlev668 CHARACTER(LEN=*), INTENT(IN) :: name669 CHARACTER(LEN=*), INTENT(IN) :: descr670 REAL, INTENT(IN) :: default671 !-----------------------------------------------------------------------------672 lFound = phyetat0_get21(field, [name], descr, default)673 END FUNCTION phyetat0_get20674 !==============================================================================675 LOGICAL FUNCTION phyetat0_get11(field, name, descr, default) RESULT(lFound)676 ! Same as phyetat0_get11, multiple names.677 IMPLICIT NONE678 REAL, INTENT(INOUT) :: field(:) ! klon679 CHARACTER(LEN=*), INTENT(IN) :: name(:)680 CHARACTER(LEN=*), INTENT(IN) :: descr681 REAL, INTENT(IN) :: default682 !-----------------------------------------------------------------------------683 REAL :: fld(SIZE(field),1)684 lFound = phyetat0_get21(fld, name, descr, default); field = fld(:,1)685 END FUNCTION phyetat0_get11686 !==============================================================================687 LOGICAL FUNCTION phyetat0_get21(field, name, descr, default, tname) RESULT(lFound)688 ! Same as phyetat0_get11, field on multiple levels, multiple names.689 USE iostart, ONLY: get_field690 USE print_control_mod, ONLY: lunout691 IMPLICIT NONE692 REAL, INTENT(INOUT) :: field(:,:) ! klon, nlev693 CHARACTER(LEN=*), INTENT(IN) :: name(:)694 CHARACTER(LEN=*), INTENT(IN) :: descr695 REAL, INTENT(IN) :: default696 CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: tname697 !-----------------------------------------------------------------------------698 CHARACTER(LEN=LEN(name)) :: tnam699 INTEGER :: i700 DO i = 1, SIZE(name)701 CALL get_field(TRIM(name(i)), field, lFound)702 IF(lFound) EXIT703 WRITE(lunout,*) "phyetat0: Missing field <",TRIM(name(i)),"> "704 END DO705 IF(.NOT.lFound) THEN706 WRITE(lunout,*) "Slightly distorted start ; continuing."707 field(:,:) = default708 tnam = name(1)709 ELSE710 tnam = name(i)711 END IF712 WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tnam)//' ('//TRIM(descr)//') min/max=', &713 MINval(field),' ',MAXval(field)714 IF(PRESENT(tname)) tname = tnam715 END FUNCTION phyetat0_get21716 !==============================================================================717 LOGICAL FUNCTION phyetat0_srf20(field, name, descr, default) RESULT(lFound)718 ! Read a field per sub-surface.719 ! Check whether reading succeded and use default value if not.720 IMPLICIT NONE721 REAL, INTENT(INOUT) :: field(:,:)722 CHARACTER(LEN=*), INTENT(IN) :: name723 CHARACTER(LEN=*), INTENT(IN) :: descr724 REAL, INTENT(IN) :: default725 !-----------------------------------------------------------------------------726 REAL :: fld(SIZE(field,1),1,SIZE(field,2))727 lFound = phyetat0_srf31(fld, [name], descr, default); field = fld(:,1,:)728 END FUNCTION phyetat0_srf20729 730 !==============================================================================731 LOGICAL FUNCTION phyetat0_srf30(field, name, descr, default) RESULT(lFound)732 ! Same as phyetat0_sfr11, multiple names tested one after the other.733 IMPLICIT NONE734 REAL, INTENT(INOUT) :: field(:,:,:)735 CHARACTER(LEN=*), INTENT(IN) :: name736 CHARACTER(LEN=*), INTENT(IN) :: descr737 REAL, INTENT(IN) :: default738 !-----------------------------------------------------------------------------739 lFound = phyetat0_srf31(field, [name], descr, default)740 END FUNCTION phyetat0_srf30741 742 !==============================================================================743 LOGICAL FUNCTION phyetat0_srf21(field, name, descr, default) RESULT(lFound)744 ! Same as phyetat0_sfr11, field on multiple levels.745 IMPLICIT NONE746 REAL, INTENT(INOUT) :: field(:,:)747 CHARACTER(LEN=*), INTENT(IN) :: name(:)748 CHARACTER(LEN=*), INTENT(IN) :: descr749 REAL, INTENT(IN) :: default750 !-----------------------------------------------------------------------------751 REAL :: fld(SIZE(field,1),1,SIZE(field,2))752 lFound = phyetat0_srf31(fld, name, descr, default); field = fld(:,1,:)753 END FUNCTION phyetat0_srf21754 755 !==============================================================================756 LOGICAL FUNCTION phyetat0_srf31(field, name, descr, default) RESULT(lFound)757 ! Same as phyetat0_sfr11, field on multiple levels, multiple names tested one after the other.758 USE iostart, ONLY: get_field759 USE print_control_mod, ONLY: lunout760 USE strings_mod, ONLY: int2str, maxlen761 IMPLICIT NONE762 REAL, INTENT(INOUT) :: field(:,:,:)763 CHARACTER(LEN=*), INTENT(IN) :: name(:)764 CHARACTER(LEN=*), INTENT(IN) :: descr765 REAL, INTENT(IN) :: default766 !-----------------------------------------------------------------------------767 INTEGER :: nsrf, i768 CHARACTER(LEN=maxlen) :: nam(SIZE(name)), tname, des769 IF(SIZE(field,3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1)770 DO nsrf = 1, SIZE(field,3)771 DO i = 1, SIZE(name); nam(i) = TRIM(name(i))//TRIM(int2str(nsrf,2)); END DO772 des = TRIM(descr)//" srf:"//int2str(nsrf,2)773 lFound = phyetat0_get21(field(:,:,nsrf), nam, TRIM(des), default, tname)774 END DO775 WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tname)//' ('//TRIM(descr)//') min/max=', &776 MINval(field),' ',MAXval(field)777 END FUNCTION phyetat0_srf31778 779 645 END MODULE phyetat0_mod 780 646 -
LMDZ6/branches/Ocean_skin/libf/phylmdiso/physiq_mod.F90
r4368 r4369 39 39 USE ioipsl_getin_p_mod, ONLY : getin_p 40 40 USE indice_sol_mod 41 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac , nqCO241 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac 42 42 USE readTracFiles_mod, ONLY: addPhase 43 USE strings_mod, ONLY: strIdx , strStack, int2str43 USE strings_mod, ONLY: strIdx 44 44 USE iophy 45 45 USE limit_read_mod, ONLY : init_limit_read … … 56 56 USE phystokenc_mod, ONLY: offline, phystokenc 57 57 USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, & 58 year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour 58 year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour, calend 59 59 !! USE phys_local_var_mod, ONLY : a long list of variables 60 60 !! ==> see below, after "CPP Keys" section … … 69 69 USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz 70 70 USE regr_pr_time_av_m, only: regr_pr_time_av 71 USE surface_data, ONLY : type_ocean, ok_veget, landice_opt 72 USE time_phylmdz_mod, only: annee_ref, current_time, day_ini, day_ref, & 73 day_step_phy, itau_phy, pdtphys, raz_date, start_time, update_time 71 USE surface_data, ONLY : type_ocean, ok_veget 72 USE time_phylmdz_mod, only: current_time, itau_phy, pdtphys, raz_date, update_time 74 73 USE tracinca_mod, ONLY: config_inca 75 74 USE tropopause_m, ONLY: dyn_tropopause 76 75 USE ice_sursat_mod, ONLY: flight_init, airplane 77 76 USE vampir 78 USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp79 77 USE write_field_phy 78 #ifdef CPP_XIOS 79 USE wxios, ONLY: g_ctx, wxios_set_context 80 #endif 80 81 USE lscp_mod, ONLY : lscp 82 USE wake_ini_mod, ONLY : wake_ini 81 83 USE thermcell_ini_mod, ONLY : thermcell_ini 82 84 … … 97 99 98 100 101 #ifdef INCA 102 USE geometry_mod, ONLY: longitude, latitude, boundslon, boundslat, ind_cell_glo 103 USE time_phylmdz_mod, ONLY: ndays 104 USE infotrac_phy, ONLY: nqCO2 105 #endif 99 106 #ifdef REPROBUS 100 USE CHEM_REP, ONLY : Init_chem_rep_xjour, & 101 d_q_rep,d_ql_rep,d_qi_rep,ptrop,ttrop, & 102 ztrop, gravit,itroprep, Z1,Z2,fac,B 107 USE chem_rep, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, & 108 ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B 109 #endif 110 #if defined INCA || defined REPROBUS 111 USE time_phylmdz_mod, ONLY: annee_ref, day_ini, day_ref, start_time 112 USE vertical_layers_mod, ONLY: aps, bps, ap, bp 103 113 #endif 104 114 … … 106 116 #ifdef CPP_RRTM 107 117 USE YOERAD, ONLY : NRADLP 108 USE YOESW, ONLY : RSUN118 ! USE YOESW, ONLY : RSUN 109 119 #endif 110 120 … … 116 126 117 127 #ifdef CPP_XIOS 118 USE xios, ONLY: xios_update_calendar, xios_context_finalize, & 119 xios_get_field_attr, xios_field_is_active 128 USE xios, ONLY: xios_update_calendar, xios_context_finalize 129 USE xios, ONLY: xios_get_field_attr, xios_field_is_active, xios_context 130 USE xios, ONLY: xios_set_current_context 120 131 USE wxios, ONLY: missing_val, missing_val_omp 121 132 #endif … … 180 191 d_t_ajsb,d_q_ajsb, & 181 192 d_t_ajs,d_q_ajs,d_u_ajs,d_v_ajs, & 182 d_t_ajs_w,d_q_ajs_w, &183 d_t_ajs_x,d_q_ajs_x, &193 ! d_t_ajs_w,d_q_ajs_w, & 194 ! d_t_ajs_x,d_q_ajs_x, & 184 195 ! 185 196 d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, & … … 194 205 d_ts, & 195 206 ! 196 d_t_oli,d_u_oli,d_v_oli, &207 ! d_t_oli,d_u_oli,d_v_oli, & 197 208 d_t_oro,d_u_oro,d_v_oro, & 198 209 d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, & … … 366 377 #endif 367 378 ! 368 369 379 370 380 IMPLICIT NONE … … 579 589 ! 580 590 ! 581 INTEGER debug582 591 INTEGER n 583 592 !ym INTEGER npoints … … 636 645 ! Upmost level reached by deep convection and related variable (jyg) 637 646 ! 638 INTEGER izero647 ! INTEGER izero 639 648 INTEGER k_upper_cv 640 649 !------------------------------------------------------------------ … … 814 823 REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt) 815 824 ! RomP <<< 816 REAL :: calday817 825 818 826 !IM cf FH pour Tiedtke 080604 … … 934 942 real zqsat(klon,klev) 935 943 ! 936 INTEGER i, k, iq, j, nsrf, ll, l, itr944 INTEGER i, k, iq, nsrf, l, itr 937 945 #ifdef ISO 938 946 real zxt_apres(ntraciso,klon) … … 1056 1064 1057 1065 REAL picefra(klon,klev) 1066 REAL zrel_mount(klon) 1058 1067 !IM cf. AM 081204 END 1059 1068 ! … … 1265 1274 1266 1275 #ifdef INCA 1276 REAL :: calday, zxsnow_dummy(klon) 1267 1277 ! set de variables utilisees pour l'initialisation des valeurs provenant de INCA 1268 1278 REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_tauinca … … 1313 1323 phys_tstep=NINT(pdtphys) 1314 1324 #ifdef CPP_XIOS 1315 IF (.NOT. debut .AND. is_omp_master) CALL xios_update_calendar(itap+1) 1325 ! switch to XIOS LMDZ physics context 1326 IF (.NOT. debut .AND. is_omp_master) THEN 1327 CALL wxios_set_context() 1328 CALL xios_update_calendar(itap+1) 1329 ENDIF 1316 1330 #endif 1317 1331 … … 1403 1417 WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', & 1404 1418 '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.' 1419 abort_message='see above' 1420 CALL abort_physic(modname,abort_message,1) 1421 ENDIF 1422 1423 IF (ok_plane_h2o.AND..NOT.ok_ice_sursat) THEN 1424 WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_sursat=y ' 1425 abort_message='see above' 1426 CALL abort_physic(modname,abort_message,1) 1427 ENDIF 1428 1429 IF (ok_plane_contrail.AND..NOT.ok_ice_sursat) THEN 1430 WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_sursat=y ' 1405 1431 abort_message='see above' 1406 1432 CALL abort_physic(modname,abort_message,1) … … 1847 1873 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1848 1874 ! Nouvelle initialisation pour le rayonnement RRTM 1849 !1850 1875 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1851 1876 1852 1877 CALL iniradia(klon,klev,paprs(1,1:klev+1)) 1853 1878 1854 1855 1879 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1880 CALL wake_ini(rg,rd,rv,prt_level) 1856 1881 CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, & 1857 1882 & RG,RD,RCPD,RKAPPA,RLVTT,RETV) 1883 1884 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1885 1858 1886 ! 1859 1887 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 2151 2179 !c ENDDO 2152 2180 ! 2153 IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN 2181 IF (ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) THEN ! ModThL 2154 2182 #ifdef INCA 2155 2183 CALL VTe(VTphysiq) … … 2158 2186 WRITE(lunout,*) 'initial time chemini', days_elapsed, calday 2159 2187 2160 CALL chemini( & 2161 rg, & 2162 ra, & 2163 cell_area, & 2164 latitude_deg, & 2165 longitude_deg, & 2166 presnivs, & 2167 calday, & 2168 klon, & 2169 nqtot, & 2170 nqo+nqCO2, & 2171 pdtphys, & 2172 annee_ref, & 2173 year_cur, & 2174 day_ref, & 2175 day_ini, & 2176 start_time, & 2177 itau_phy, & 2178 date0, & 2179 io_lon, & 2180 io_lat, & 2181 chemistry_couple, & 2182 init_source, & 2183 init_tauinca, & 2184 init_pizinca, & 2185 init_cginca, & 2186 init_ccminca) 2188 call init_const_lmdz( & 2189 ndays, nbsrf, is_oce,is_sic, is_ter,is_lic, calend, & 2190 config_inca) 2191 2192 CALL init_inca_geometry( & 2193 longitude, latitude, & 2194 boundslon, boundslat, & 2195 cell_area, ind_cell_glo) 2196 2197 if (grid_type==unstructured) THEN 2198 CALL chemini( pplay, & 2199 nbp_lon, nbp_lat, & 2200 latitude_deg, & 2201 longitude_deg, & 2202 presnivs, & 2203 calday, & 2204 klon, & 2205 nqtot, & 2206 nqo+nqCO2, & 2207 pdtphys, & 2208 annee_ref, & 2209 year_cur, & 2210 day_ref, & 2211 day_ini, & 2212 start_time, & 2213 itau_phy, & 2214 date0, & 2215 chemistry_couple, & 2216 init_source, & 2217 init_tauinca, & 2218 init_pizinca, & 2219 init_cginca, & 2220 init_ccminca) 2221 ELSE 2222 CALL chemini( pplay, & 2223 nbp_lon, nbp_lat, & 2224 latitude_deg, & 2225 longitude_deg, & 2226 presnivs, & 2227 calday, & 2228 klon, & 2229 nqtot, & 2230 nqo+nqCO2, & 2231 pdtphys, & 2232 annee_ref, & 2233 year_cur, & 2234 day_ref, & 2235 day_ini, & 2236 start_time, & 2237 itau_phy, & 2238 date0, & 2239 chemistry_couple, & 2240 init_source, & 2241 init_tauinca, & 2242 init_pizinca, & 2243 init_cginca, & 2244 init_ccminca, & 2245 io_lon, & 2246 io_lat) 2247 ENDIF 2187 2248 2188 2249 … … 2286 2347 2287 2348 2349 2288 2350 ENDIF 2289 2351 ! … … 2390 2452 ql_seri(i,k) = qx(i,k,iliq) 2391 2453 !CR: ATTENTION, on rajoute la variable glace 2392 IF (nqo. eq.2) THEN2454 IF (nqo.EQ.2) THEN !--vapour and liquid only 2393 2455 qs_seri(i,k) = 0. 2394 ELSE IF (nqo.eq.3) THEN 2456 rneb_seri(i,k) = 0. 2457 ELSE IF (nqo.EQ.3) THEN !--vapour, liquid and ice 2395 2458 qs_seri(i,k) = qx(i,k,isol) 2396 ELSE IF (nqo.eq.4) THEN 2459 rneb_seri(i,k) = 0. 2460 ELSE IF (nqo.EQ.4) THEN !--vapour, liquid, ice and rneb 2397 2461 qs_seri(i,k) = qx(i,k,isol) 2398 2462 rneb_seri(i,k) = qx(i,k,irneb) … … 2658 2722 ! !! RomP >>> td dyn traceur 2659 2723 IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0 2724 ! !! RomP <<< 2660 2725 d_rneb_dyn(:,:)=0.0 2661 ! !! RomP <<<2662 2726 ancien_ok = .TRUE. 2663 2727 ENDIF … … 4608 4672 IF (ok_new_lscp) THEN 4609 4673 4674 !--mise à jour de flight_m et flight_h2o dans leur module 4675 IF (ok_plane_h2o .OR. ok_plane_contrail) THEN 4676 CALL airplane(debut,pphis,pplay,paprs,t_seri) 4677 ENDIF 4678 4610 4679 CALL lscp(phys_tstep,missing_val,paprs,pplay, & 4611 4680 t_seri, q_seri,ptconv,ratqs, & … … 4619 4688 4620 4689 ELSE 4690 4621 4691 CALL fisrtilp(phys_tstep,paprs,pplay, & 4622 4692 t_seri, q_seri,ptconv,ratqs, & … … 4690 4760 ENDDO 4691 4761 ENDDO 4692 IF (nqo ==3) THEN4762 IF (nqo >= 3) THEN 4693 4763 DO k = 1, klev 4694 4764 DO i = 1, klon … … 5732 5802 DO i=1,klon 5733 5803 itest(i)=0 5734 ! IF ((zstd(i).gt.10.0)) THEN 5735 IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN 5804 zrel_mount(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) 5805 !zrel_mount: relative mountain height wrt relief explained by mean slope 5806 ! -> condition on zrel_mount can deactivate the drag on tilted planar terrains 5807 ! such as ice sheets (work by V. Wiener) 5808 IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0).AND.(zrel_mount(i).GE.zrel_mount_t)) THEN 5736 5809 itest(i)=1 5737 5810 igwd=igwd+1 … … 5786 5859 DO i=1,klon 5787 5860 itest(i)=0 5788 IF ((zpic(i)-zmea(i)).GT.100.) THEN 5861 !zrel_mount: relative mountain height wrt relief explained by mean slope 5862 ! -> condition on zrel_mount can deactivate the lifting on tilted planar terrains 5863 ! such as ice sheets (work by V. Wiener) 5864 zrel_mount(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) 5865 IF (((zpic(i)-zmea(i)).GT.100.).AND.(zrel_mount(i).GE.zrel_mount_t)) THEN 5789 5866 itest(i)=1 5790 5867 igwd=igwd+1 … … 6273 6350 ELSE 6274 6351 sh_in(:,:) = qx(:,:,ivap) 6275 IF (nqo .EQ.3) THEN6352 IF (nqo >= 3) THEN 6276 6353 ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol) 6277 6354 ELSE … … 6360 6437 ! Calculer le transport de l'eau et de l'energie (diagnostique) 6361 6438 ! 6362 CALL transp (paprs, 6439 CALL transp (paprs,zxtsol, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, & 6363 6440 ue, ve, uq, vq, uwat, vwat) 6364 6441 ! … … 6366 6443 IF(1.EQ.0) THEN 6367 6444 ! 6368 CALL transp_lay (paprs,zxtsol, & 6369 t_seri, q_seri, u_seri, v_seri, zphi, & 6445 CALL transp_lay (paprs,zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, & 6370 6446 ve_lay, vq_lay, ue_lay, uq_lay) 6371 6447 ! … … 6445 6521 pphis, & 6446 6522 zx_rh, & 6447 aps, bps, ap, bp )6523 aps, bps, ap, bp, lafin) 6448 6524 6449 6525 CALL VTe(VTinca) … … 6452 6528 ENDIF 6453 6529 6530 IF (ANY(types_trac == 'repr')) THEN 6531 #ifdef REPROBUS 6532 CALL coord_hyb_rep(paprs, pplay, aps, bps, ap, bp, cell_area) 6533 #endif 6534 ENDIF 6454 6535 6455 6536 ! … … 6475 6556 d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep 6476 6557 !CR: on ajoute le contenu en glace 6477 IF (nqo .ge.3) THEN6558 IF (nqo >= 3) THEN 6478 6559 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep 6479 6560 ENDIF 6480 6561 !--ice_sursat: nqo=4, on ajoute rneb 6481 IF (nqo .eq.4) THEN6562 IF (nqo == 4) THEN 6482 6563 d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep 6483 6564 ENDIF … … 6501 6582 enddo ! DO k = 1, klev 6502 6583 enddo !do ixt=1,ntraciso 6503 !#ifdef ISOVERIF 6504 ! write(*,*) 'physiq 6120: d_qx(1,1,:)=',d_qx(1,1,:) 6505 ! write(*,*) 'qx(1,1,:)=',qx(1,1,:) 6506 ! write(*,*) 'xt_seri(:,1,1)=',xt_seri(:,1,1) 6507 !#endif 6508 #endif 6509 ! #ifdef ISO 6584 #endif 6510 6585 ! DC: All iterations are cycled if nqtot==nqo, so no nqtot>nqo condition required 6511 6586 itr = 0 … … 6567 6642 ql_ancien(:,:) = ql_seri(:,:) 6568 6643 qs_ancien(:,:) = qs_seri(:,:) 6644 rneb_ancien(:,:) = rneb_seri(:,:) 6569 6645 #ifdef ISO 6570 6646 xt_ancien(:,:,:)=xt_seri(:,:,:) … … 6826 6902 #ifdef CPP_XIOS 6827 6903 IF (is_omp_master) CALL xios_context_finalize 6904 6905 #ifdef INCA 6906 if (ANY(types_trac == 'inca' )) then 6907 IF (is_omp_master .and. grid_type==unstructured) THEN 6908 CALL finalize_inca 6909 ENDIF 6910 endif 6911 #endif 6912 6828 6913 #endif 6829 6914 WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
Note: See TracChangeset
for help on using the changeset viewer.