Ignore:
Timestamp:
Dec 5, 2022, 9:44:54 PM (3 years ago)
Author:
dcugnet
Message:
  • adding missing SAVE attribute for that in check_isotopes
  • move phyetat0_get/_srf from phylmd[iso]/phyetat0_mod to new module phyetat0_get_mod -> break circular dependency
  • remove unused variables from physiq_mod
  • update phylmdiso/physiq_mod with respect to phylmd/physiq_mod (few updates were not included)
Location:
LMDZ6/trunk/libf/phylmd
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed

  • TabularUnified LMDZ6/trunk/libf/phylmd/phyetat0_mod.F90

    r4359 r4367  
    44
    55  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
    147
    158CONTAINS
    … …  
    2316  USE pbl_surface_mod,  ONLY : pbl_surface_init
    2417  USE surface_data,     ONLY : type_ocean, version_ocean
     18  USE phyetat0_get_mod, ONLY : phyetat0_get, phyetat0_srf
    2519  USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, phys_tstep, &
    2620       qsol, fevap, z0m, z0h, agesno, &
    … …  
    597591END SUBROUTINE phyetat0
    598592
    599 !==============================================================================
    600 LOGICAL FUNCTION phyetat0_get10(field, name, descr, default) RESULT(lFound)
    601 ! Read a field. Check whether reading succeded and use default value if not.
    602   IMPLICIT NONE
    603   REAL,             INTENT(INOUT) :: field(:) ! klon
    604   CHARACTER(LEN=*), INTENT(IN)    :: name
    605   CHARACTER(LEN=*), INTENT(IN)    :: descr
    606   REAL,             INTENT(IN)    :: default
    607 !------------------------------------------------------------------------------
    608   REAL :: fld(SIZE(field),1)
    609   lFound = phyetat0_get21(fld, [name], descr, default); field = fld(:,1)
    610 END FUNCTION phyetat0_get10
    611 !==============================================================================
    612 LOGICAL FUNCTION phyetat0_get20(field, name, descr, default) RESULT(lFound)
    613 ! Same as phyetat0_get11, field on multiple levels.
    614   IMPLICIT NONE
    615   REAL,             INTENT(INOUT) :: field(:,:) ! klon, nlev
    616   CHARACTER(LEN=*), INTENT(IN)    :: name
    617   CHARACTER(LEN=*), INTENT(IN)    :: descr
    618   REAL,             INTENT(IN)    :: default
    619 !-----------------------------------------------------------------------------
    620   lFound = phyetat0_get21(field, [name], descr, default)
    621 END FUNCTION phyetat0_get20
    622 !==============================================================================
    623 LOGICAL FUNCTION phyetat0_get11(field, name, descr, default) RESULT(lFound)
    624 ! Same as phyetat0_get11, multiple names.
    625   IMPLICIT NONE
    626   REAL,             INTENT(INOUT) :: field(:) ! klon
    627   CHARACTER(LEN=*), INTENT(IN)    :: name(:)
    628   CHARACTER(LEN=*), INTENT(IN)    :: descr
    629   REAL,             INTENT(IN)    :: default
    630 !-----------------------------------------------------------------------------
    631   REAL :: fld(SIZE(field),1)
    632   lFound = phyetat0_get21(fld, name, descr, default); field = fld(:,1)
    633 END FUNCTION phyetat0_get11
    634 !==============================================================================
    635 LOGICAL FUNCTION phyetat0_get21(field, name, descr, default, tname) RESULT(lFound)
    636 ! Same as phyetat0_get11, field on multiple levels, multiple names.
    637   USE iostart,           ONLY: get_field
    638   USE print_control_mod, ONLY: lunout
    639   IMPLICIT NONE
    640   REAL,             INTENT(INOUT) :: field(:,:) ! klon, nlev
    641   CHARACTER(LEN=*), INTENT(IN)    :: name(:)
    642   CHARACTER(LEN=*), INTENT(IN)    :: descr
    643   REAL,             INTENT(IN)    :: default
    644   CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: tname
    645 !-----------------------------------------------------------------------------
    646   CHARACTER(LEN=LEN(name)) :: tnam
    647   INTEGER :: i
    648   DO i = 1, SIZE(name)
    649     CALL get_field(TRIM(name(i)), field, lFound)
    650     IF(lFound) EXIT
    651     WRITE(lunout,*) "phyetat0: Missing field <",TRIM(name(i)),"> "
    652   END DO
    653   IF(.NOT.lFound) THEN
    654     WRITE(lunout,*) "Slightly distorted start ; continuing."
    655     field(:,:) = default
    656     tnam = name(1)
    657   ELSE
    658     tnam = name(i)
    659   END IF
    660   WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tnam)//' ('//TRIM(descr)//') min/max=', &
    661     MINval(field),' ',MAXval(field)
    662   IF(PRESENT(tname)) tname = tnam
    663 END FUNCTION phyetat0_get21
    664 !==============================================================================
    665 LOGICAL FUNCTION phyetat0_srf20(field, name, descr, default) RESULT(lFound)
    666 ! Read a field per sub-surface.
    667 ! Check whether reading succeded and use default value if not.
    668   IMPLICIT NONE
    669   REAL,             INTENT(INOUT) :: field(:,:)
    670   CHARACTER(LEN=*), INTENT(IN)    :: name
    671   CHARACTER(LEN=*), INTENT(IN)    :: descr
    672   REAL,             INTENT(IN)    :: default
    673 !-----------------------------------------------------------------------------
    674   REAL :: fld(SIZE(field,1),1,SIZE(field,2))
    675   lFound = phyetat0_srf31(fld, [name], descr, default); field = fld(:,1,:)
    676 END FUNCTION phyetat0_srf20
    677 
    678 !==============================================================================
    679 LOGICAL FUNCTION phyetat0_srf30(field, name, descr, default) RESULT(lFound)
    680 ! Same as phyetat0_sfr11, multiple names tested one after the other.
    681   IMPLICIT NONE
    682   REAL,             INTENT(INOUT) :: field(:,:,:)
    683   CHARACTER(LEN=*), INTENT(IN)    :: name
    684   CHARACTER(LEN=*), INTENT(IN)    :: descr
    685   REAL,             INTENT(IN)    :: default
    686 !-----------------------------------------------------------------------------
    687   lFound = phyetat0_srf31(field, [name], descr, default)
    688 END FUNCTION phyetat0_srf30
    689 
    690 !==============================================================================
    691 LOGICAL FUNCTION phyetat0_srf21(field, name, descr, default) RESULT(lFound)
    692 ! Same as phyetat0_sfr11, field on multiple levels.
    693   IMPLICIT NONE
    694   REAL,             INTENT(INOUT) :: field(:,:)
    695   CHARACTER(LEN=*), INTENT(IN)    :: name(:)
    696   CHARACTER(LEN=*), INTENT(IN)    :: descr
    697   REAL,             INTENT(IN)    :: default
    698 !-----------------------------------------------------------------------------
    699   REAL :: fld(SIZE(field,1),1,SIZE(field,2))
    700   lFound = phyetat0_srf31(fld, name, descr, default); field = fld(:,1,:)
    701 END FUNCTION phyetat0_srf21
    702 
    703 !==============================================================================
    704 LOGICAL FUNCTION phyetat0_srf31(field, name, descr, default) RESULT(lFound)
    705 ! Same as phyetat0_sfr11, field on multiple levels, multiple names tested one after the other.
    706   USE iostart,           ONLY: get_field
    707   USE print_control_mod, ONLY: lunout
    708   USE strings_mod,       ONLY: int2str, maxlen
    709   IMPLICIT NONE
    710   REAL,             INTENT(INOUT) :: field(:,:,:)
    711   CHARACTER(LEN=*), INTENT(IN)    :: name(:)
    712   CHARACTER(LEN=*), INTENT(IN)    :: descr
    713   REAL,             INTENT(IN)    :: default
    714 !-----------------------------------------------------------------------------
    715   INTEGER :: nsrf, i
    716   CHARACTER(LEN=maxlen) :: nam(SIZE(name)), tname, des
    717   IF(SIZE(field,3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1)
    718   DO nsrf = 1, SIZE(field,3)
    719     DO i = 1, SIZE(name); nam(i) = TRIM(name(i))//TRIM(int2str(nsrf,2)); END DO
    720     des = TRIM(descr)//" srf:"//int2str(nsrf,2)
    721     lFound = phyetat0_get21(field(:,:,nsrf), nam, TRIM(des), default, tname)
    722   END DO
    723   WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tname)//' ('//TRIM(descr)//') min/max=', &
    724     MINval(field),' ',MAXval(field)
    725 END FUNCTION phyetat0_srf31
    726 
    727593END MODULE phyetat0_mod
    728594

  • TabularUnified LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r4358 r4367  
    3434    USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
    3535    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
    3837    USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
    3938         histwrite, ju2ymds, ymds2ju, getin
    4039    USE ioipsl_getin_p_mod, ONLY : getin_p
    4140    USE indice_sol_mod
    42     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac, nqCO2
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, types_trac
    4342    USE readTracFiles_mod, ONLY: addPhase
    4443    USE strings_mod,  ONLY: strIdx
    … …  
    7069    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
    7170    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
    7573    USE tracinca_mod, ONLY: config_inca
    7674    USE tropopause_m,     ONLY: dyn_tropopause
    7775    USE ice_sursat_mod,  ONLY: flight_init, airplane
    7876    USE vampir
    79     USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
    8077    USE write_field_phy
    8178#ifdef CPP_XIOS
    … …  
    10299
    103100
     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
    104106#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
    108113#endif
    109114
    … …  
    111116#ifdef CPP_RRTM
    112117    USE YOERAD, ONLY : NRADLP
    113     USE YOESW, ONLY : RSUN
     118!    USE YOESW, ONLY : RSUN
    114119#endif
    115120
    … …  
    147152       d_t_ajsb,d_q_ajsb, &
    148153       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, &
    151156       !
    152157       d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, &
    … …  
    161166       d_ts, &
    162167       !
    163        d_t_oli,d_u_oli,d_v_oli, &
     168!       d_t_oli,d_u_oli,d_v_oli, &
    164169       d_t_oro,d_u_oro,d_v_oro, &
    165170       d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, &
    … …  
    492497    REAL dtadd(klon,klev)
    493498
    494 !#ifdef CPP_XIOS
    495 !    TYPE(xios_context), SAVE :: g_ctx
    496 !#endif
    497 
    498499#ifndef CPP_XIOS
    499500    REAL, SAVE :: missing_val=nf90_fill_real
    … …  
    522523    !
    523524    !
    524     INTEGER debug
    525525    INTEGER n
    526526    !ym      INTEGER npoints
    … …  
    579579    ! Upmost level reached by deep convection and related variable (jyg)
    580580    !
    581     INTEGER izero
     581!    INTEGER izero
    582582    INTEGER k_upper_cv
    583583    !------------------------------------------------------------------
    … …  
    749749    REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
    750750    ! RomP <<<
    751     REAL          :: calday
    752751
    753752    !IM cf FH pour Tiedtke 080604
    … …  
    846845    REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
    847846    !
    848 #ifdef INCA
    849     REAL zxsnow_dummy(klon)
    850 #endif
    851847    REAL zsav_tsol(klon)
    852848    !
    … …  
    863859    real zqsat(klon,klev)
    864860    !
    865     INTEGER i, k, iq, j, nsrf, ll, l, itr
     861    INTEGER i, k, iq, nsrf, l, itr
    866862    !
    867863    REAL t_coup
    … …  
    11791175
    11801176#ifdef INCA
     1177    REAL :: calday, zxsnow_dummy(klon)
    11811178    ! set de variables utilisees pour l'initialisation des valeurs provenant de INCA
    11821179    REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_tauinca
    … …  
    12251222#ifdef CPP_XIOS
    12261223! switch to XIOS LMDZ physics context
    1227 !!!!$OMP MASTER
    1228 !!!!    WRITE(*,*)'PHYSICS XIOS Context :', g_ctx
    1229 !!!!    CALL wxios_set_context()
    1230 !!!!$OMP END MASTER
    12311224    IF (.NOT. debut .AND. is_omp_master) THEN
    12321225       CALL wxios_set_context()
    … …  
    13021295       CALL strataer_init
    13031296#endif
    1304 
    1305        !!CALL flight_init
    13061297
    13071298       print*, '================================================='
    … …  
    22212212      ENDIF
    22222213    ENDIF
    2223 ! switch to XIOS LMDZ physics context just in case
    2224 !$OMP MASTER
    2225 !!!!#ifdef CPP_XIOS
    2226 !!!!    WRITE(*,*)'PHYSICS XIOS Context :', g_ctx
    2227 !!!!    CALL xios_set_current_context(g_ctx)
    2228 !!!!#endif
    2229 !$OMP END MASTER
    2230 
    22312214    !
    22322215    !
    … …  
    51895172    ENDDO
    51905173    !
    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
    52005182          ENDDO
    52015183       ENDDO
    5202     ENDIF
     5184    ENDDO
    52035185    !
    52045186    !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
Note: See TracChangeset for help on using the changeset viewer.