Ignore:
Timestamp:
Jul 23, 2024, 3:29:36 PM (8 weeks ago)
Author:
abarral
Message:

Handle CPP_INLANDSIS in lmdz_cppkeys_wrapper.F90
Remove obsolete key wrgrads_thermcell, _ADV_HALO, _ADV_HALLO, isminmax
Remove redundant uses of CPPKEY_INCA (thanks acozic)
Remove obsolete misc/write_field.F90
Remove unused ioipsl_* wrappers
Remove calls to WriteField_u with wrong signature
Convert .F -> .[fF]90
(lint) uppercase fortran operators
[note: 1d and iso still broken - working on it]

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/physiq_mod.F90

    r5101 r5103  
    349349            reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra
    350350    USE output_physiqex_mod, ONLY: output_physiqex
    351     USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
    352351
    353352    IMPLICIT NONE
    … …  
    776775
    777776    !@$$      LOGICAL offline           ! Controle du stockage ds "physique"
    778     !@$$      PARAMETER (offline=.false.)
     777    !@$$      PARAMETER (offline=.FALSE.)
    779778    !@$$      INTEGER physid
    780779    REAL frac_impa(klon, klev) ! fractions d'aerosols lessivees (impaction)
    … …  
    12611260    if (debut) then                                                        !
    12621261      iflag_physiq = 0
    1263       call getin_p('iflag_physiq', iflag_physiq)                          !
     1262      CALL getin_p('iflag_physiq', iflag_physiq)                          !
    12641263    endif                                                                  !
    12651264    if (iflag_physiq == 2) then                                          !
    1266       call physiqex (nlon, nlev, &                                         !
     1265      CALL physiqex (nlon, nlev, &                                         !
    12671266              debut, lafin, pdtphys_, &                                             !
    12681267              paprs, pplay, pphi, pphis, presnivs, &                                  !
    … …  
    12761275    pi = 4. * ATAN(1.)
    12771276
    1278     ! set-up call to alerte function
     1277    ! set-up CALL to alerte function
    12791278    call_alert = (alert_first_call .AND. is_master)
    12801279
    … …  
    13651364              CALL regr_horiz_time_climoz(read_climoz, ok_daily_climoz)
    13661365
    1367       print*, '================================================='
     1366      PRINT*, '================================================='
    13681367
    13691368      !CR: check sur le nb de traceurs de l eau
    … …  
    14481447      WRITE(lunout, *) 'debut physiq_mod tau_gl=', tau_gl
    14491448      iflag_thermcell_tke = 0
    1450       call getin_p('iflag_thermcell_tke', iflag_thermcell_tke)                          !
     1449      CALL getin_p('iflag_thermcell_tke', iflag_thermcell_tke)                          !
    14511450
    14521451      CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond)
    … …  
    14761475      fl_cor_ebil = 0 ! by default, no correction to ensure energy conservation
    14771476      CALL getin_p('fl_cor_ebil', fl_cor_ebil)
    1478       iflag_phytrac = 1 ! by default we do want to call phytrac
     1477      iflag_phytrac = 1 ! by default we do want to CALL phytrac
    14791478      CALL getin_p('iflag_phytrac', iflag_phytrac)
    14801479
    … …  
    14821481      CALL getin_p('ok_water_mass_fixer', ok_water_mass_fixer)
    14831482      IF (CPPKEY_DUST) THEN
    1484         IF (iflag_phytrac.EQ.0) THEN
     1483        IF (iflag_phytrac==0) THEN
    14851484          WRITE(lunout, *) 'In order to run with SPLA, iflag_phytrac will be forced to 1'
    14861485          iflag_phytrac = 1
    … …  
    15141513      !AI 08 2023
    15151514#ifdef CPP_ECRAD
    1516        ok_3Deffect=.false.
     1515       ok_3Deffect=.FALSE.
    15171516       CALL getin_p('ok_3Deffect',ok_3Deffect)
    15181517       namelist_ecrad_file='namelist_ecrad'
    … …  
    15841583      clwcon(:, :) = 0.0
    15851584
    1586       print*, 'iflag_coupl,iflag_clos,iflag_wake', &
     1585      PRINT*, 'iflag_coupl,iflag_clos,iflag_wake', &
    15871586              iflag_coupl, iflag_clos, iflag_wake
    1588       print*, 'iflag_cycle_diurne', iflag_cycle_diurne
     1587      PRINT*, 'iflag_cycle_diurne', iflag_cycle_diurne
    15891588
    15901589      IF (iflag_con==2.AND.iflag_cld_th>-1) THEN
    … …  
    16741673        CLOSE(98)
    16751674        IF(nCFMIP>npCFMIP) THEN
    1676           print*, 'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
     1675          PRINT*, 'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
    16771676          CALL abort_physic("physiq", "", 1)
    16781677        ELSE
    1679           print*, 'physiq npCFMIP=', npCFMIP, 'nCFMIP=', nCFMIP
     1678          PRINT*, 'physiq npCFMIP=', npCFMIP, 'nCFMIP=', nCFMIP
    16801679        ENDIF
    16811680
    … …  
    17081707      ENDIF
    17091708
    1710 #ifdef CPP_IOIPSL
    17111709
    17121710       !$OMP MASTER
    1713        ! FH : if ok_sync=.true. , the time axis is written at each time step
     1711       ! FH : if ok_sync=.TRUE. , the time axis is written at each time step
    17141712       ! in the output files. Only at the end in the opposite case
    17151713       ok_sync_omp=.FALSE.
    … …  
    17401738      END IF
    17411739
    1742 #endif
    17431740      ecrit_reg = ecrit_reg * un_jour
    17441741      ecrit_tra = ecrit_tra * un_jour
    … …  
    19201917      ENDIF
    19211918      !IM begin
    1922       print*, 'physiq: clwcon rnebcon ratqs', clwcon(1, 1), rnebcon(1, 1) &
     1919      PRINT*, 'physiq: clwcon rnebcon ratqs', clwcon(1, 1), rnebcon(1, 1) &
    19231920              , ratqs(1, 1)
    19241921      !IM end
    … …  
    19371934      !               pdtphys
    19381935      !          abort_message='Pas physique n est pas correct '
    1939       !          !           call abort_physic(modname,abort_message,1)
     1936      !          !           CALL abort_physic(modname,abort_message,1)
    19401937      !          phys_tstep=pdtphys
    19411938      !       ENDIF
    … …  
    19971994                  , alp_bl_prescr, ale_bl_prescr)
    19981995          ! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
    1999           !        print*,'apres ini_wake iflag_cld_th=', iflag_cld_th
     1996          !        PRINT*,'apres ini_wake iflag_cld_th=', iflag_cld_th
    20001997
    20011998          ! Initialize tendencies of wake state variables (for some flag values
    … …  
    20912088        CALL bcast_omp(missing_val)
    20922089
    2093         ! Now we activate some double radiation call flags only if some
     2090        ! Now we activate some double radiation CALL flags only if some
    20942091        ! diagnostics are requested, otherwise there is no point in doing this
    20952092        IF (is_master) THEN
    … …  
    21452142
    21462143      IF (ANY(type_trac == ['inca', 'inco'])) THEN ! ModThL
    2147         IF (CPPKEY_INCA) THEN
    21482144          CALL VTe(VTphysiq)
    21492145          CALL VTb(VTinca)
    … …  
    21512147          WRITE(lunout, *) 'initial time chemini', days_elapsed, calday
    21522148
    2153           call init_const_lmdz(&
     2149          CALL init_const_lmdz(&
    21542150                  ndays, nbsrf, is_oce, is_sic, is_ter, is_lic, calend, &
    21552151                  config_inca)
    … …  
    22212217          CALL VTe(VTinca)
    22222218          CALL VTb(VTphysiq)
    2223         END IF
    22242219      ENDIF
    22252220
    … …  
    23382333#ifdef REPROBUS
    23392334       CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
    2340        print*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
     2335       PRINT*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
    23412336       CALL Rtime(debut)
    23422337#endif
    … …  
    30563051
    30573052      IF (iflag_con==1) THEN
    3058         abort_message = 'reactiver le call conlmd dans physiq.F'
     3053        abort_message = 'reactiver le CALL conlmd dans physiq.F'
    30593054        CALL abort_physic (modname, abort_message, 1)
    30603055        !     CALL conlmd (phys_tstep, paprs, pplay, t_seri, q_seri, conv_q,
    … …  
    31053100        ! Perform dry adiabatic adjustment on wake profile
    31063101        ! The corresponding tendencies are added to the convective tendencies
    3107         ! after the call to the convective scheme.
     3102        ! after the CALL to the convective scheme.
    31083103        IF (iflag_wake>=1) then
    31093104          IF (iflag_adjwk >= 1) THEN
    … …  
    32013196
    32023197          !IM begin
    3203           !       print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
     3198          !       PRINT*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
    32043199          !    .dnwd0(1,1),ftd(1,1),fqd(1,1)
    32053200          !IM end
    … …  
    32103205
    32113206          !jyg<
    3212           ! If convective tendencies are too large, then call convection
     3207          ! If convective tendencies are too large, then CALL convection
    32133208          !  every time step
    32143209          cvpas = cvpas_0
    … …  
    32363231          ENDDO
    32373232          !!!   Ligne a ne surtout pas remettre sans avoir murement reflechi (jyg)
    3238           !!!          call bcast(cvpas)
     3233          !!!          CALL bcast(cvpas)
    32393234          !!!   ------------------------------------------------------------
    32403235          !>jyg
    … …  
    33783373    !!                     dqi0, paprs, 'convection_sat', abortphy, flag_inhib_tend,&
    33793374    !!                     itap, 1)
    3380     !!    call prt_enerbil('convection_sat',itap)
     3375    !!    CALL prt_enerbil('convection_sat',itap)
    33813376    !!
    33823377    !!
    … …  
    36853680        ! FH : 2010/02/01
    36863681        if (iflag_thermcell_tke==1) then
    3687           call thermcell_dtke(klon, klev, nbsrf, pdtphys, fm_therm, entr_therm, rg, paprs, pbl_tke)
     3682          CALL thermcell_dtke(klon, klev, nbsrf, pdtphys, fm_therm, entr_therm, rg, paprs, pbl_tke)
    36883683        endif
    36893684        ! -------------------------------------------------------------------
    … …  
    37133708        ENDIF
    37143709
    3715         ! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
     3710        ! Attention : le CALL ajsec_convV2 n'est maintenu que momentanneement
    37163711        ! pour des test de convergence numerique.
    37173712        ! Le nouveau ajsec est a priori mieux, meme pour le cas
    … …  
    39003895    IF (iflag_cld_th<=-1) THEN ! seulement pour Tiedtke
    39013896      snow_tiedtke = 0.
    3902       !     print*,'avant calcul de la pseudo precip '
    3903       !     print*,'iflag_cld_th',iflag_cld_th
     3897      !     PRINT*,'avant calcul de la pseudo precip '
     3898      !     PRINT*,'iflag_cld_th',iflag_cld_th
    39043899      IF (iflag_cld_th==-1) THEN
    39053900        rain_tiedtke = rain_con
    39063901      ELSE
    3907         !       print*,'calcul de la pseudo precip '
     3902        !       PRINT*,'calcul de la pseudo precip '
    39083903        rain_tiedtke = 0.
    3909         !         print*,'calcul de la pseudo precip 0'
     3904        !         PRINT*,'calcul de la pseudo precip 0'
    39103905        DO k = 1, klev
    39113906          DO i = 1, klon
    … …  
    39183913      ENDIF
    39193914
    3920       !     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
     3915      !     CALL dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
    39213916
    39223917      ! Nuages diagnostiques pour Tiedtke
    … …  
    40964091
    40974092    IF (ANY(type_trac == ['inca', 'inco'])) THEN ! ModThL
    4098       IF (CPPKEY_INCA) THEN
    40994093        CALL VTe(VTphysiq)
    41004094        CALL VTb(VTinca)
    … …  
    41494143        CALL VTe(VTinca)
    41504144        CALL VTb(VTphysiq)
    4151       END IF
    41524145    ENDIF !type_trac = inca or inco
    41534146    IF (type_trac == 'repr') THEN
    … …  
    43524345
    43534346        !IM 251017 begin
    4354         !               print*,'physiq betaCRF global zdtime=',zdtime
     4347        !               PRINT*,'physiq betaCRF global zdtime=',zdtime
    43554348        !IM 251017 end
    43564349        DO k = 1, klev
    … …  
    44034396      !lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek
    44044397      IF (ok_chlorophyll) THEN
    4405         print*, "-- reading chlorophyll"
     4398        PRINT*, "-- reading chlorophyll"
    44064399        CALL readchlorophyll(debut)
    44074400      ENDIF
    … …  
    44334426
    44344427      IF (aerosol_couple.AND.config_inca=='aero') THEN
    4435         IF (CPPKEY_INCA) THEN
    44364428          CALL radlwsw_inca  &
    44374429                  (chemistry_couple, kdlon, kflev, dist, rmu0, fract, solaire, &
    … …  
    44534445                  cldtaupirad, &
    44544446                  topswai_aero, solswai_aero)
    4455         END IF
    44564447      ELSE
    44574448
    … …  
    46004591#ifdef CPP_ECRAD
    46014592          IF (ok_3Deffect) then
    4602 !                print*,'ok_3Deffect = ',ok_3Deffect
     4593!                PRINT*,'ok_3Deffect = ',ok_3Deffect
    46034594                namelist_ecrad_file='namelist_ecrad_s2'
    46044595                CALL radlwsw &
    … …  
    47224713
    47234714    IF (prt_level >=10) THEN
    4724       print *, ' call orography ? ', ok_orodr
     4715      print *, ' CALL orography ? ', ok_orodr
    47254716    ENDIF
    47264717
    … …  
    49894980
    49904981    IF (prt_level>=5) &
    4991             print*, 'addtkeoro', addtkeoro
     4982            PRINT*, 'addtkeoro', addtkeoro
    49924983
    49934984    alphatkeoro = 1.
    … …  
    50905081
    50915082          IF (prt_level .GE.10) THEN
    5092              print*,'freq_cosp',freq_cosp
     5083             PRINT*,'freq_cosp',freq_cosp
    50935084          ENDIF
    50945085          mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
    5095           !       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
     5086          !       PRINT*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
    50965087          !     s        ref_liq,ref_ice
    50975088          CALL phys_cosp(itap,phys_tstep,freq_cosp, &
    … …  
    51215112
    51225113          IF (prt_level .GE.10) THEN
    5123              print*,'freq_cosp',freq_cosp
     5114             PRINT*,'freq_cosp',freq_cosp
    51245115          ENDIF
    51255116          mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
    5126                  print*,'Dans physiq.F avant appel '
     5117                 PRINT*,'Dans physiq.F avant appel '
    51275118          !     s        ref_liq,ref_ice
    51285119          CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
    … …  
    51465137
    51475138          IF (prt_level .GE.10) THEN
    5148              print*,'freq_cosp',freq_cosp
     5139             PRINT*,'freq_cosp',freq_cosp
    51495140          ENDIF
    51505141           DO k = 1, klev
    … …  
    51545145           ENDDO
    51555146          mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
    5156                  print*,'Dans physiq.F avant appel '
     5147                 PRINT*,'Dans physiq.F avant appel '
    51575148          !     s        ref_liq,ref_ice
    51585149          CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
    … …  
    52675258
    52685259
    5269           print*,'avt add phys rep',abortphy
     5260          PRINT*,'avt add phys rep',abortphy
    52705261
    52715262     CALL add_phys_tend &
    … …  
    52745265        IF (abortphy==1) Print*,'ERROR ABORT REP'
    52755266
    5276           print*,'apr add phys rep',abortphy
     5267          PRINT*,'apr add phys rep',abortphy
    52775268
    52785269#endif
    … …  
    52855276
    52865277      IF (prt_level>=9) &
    5287               print*, 'Attention on met a 0 les thermiques pour phystoke'
     5278              PRINT*, 'Attention on met a 0 les thermiques pour phystoke'
    52885279      CALL phystokenc (&
    52895280              nlon, klev, pdtphys, longitude_deg, latitude_deg, &
    … …  
    54235414
    54245415    IF (ANY(type_trac == ['inca', 'inco'])) THEN
    5425       IF (CPPKEY_INCA) THEN
    54265416        CALL VTe(VTphysiq)
    54275417        CALL VTb(VTinca)
    … …  
    54435433        CALL VTe(VTinca)
    54445434        CALL VTb(VTphysiq)
    5445       END IF
    54465435    ENDIF
    54475436
    … …  
    55915580    !   Ecriture des sorties
    55925581    !=============================================================
    5593 #ifdef CPP_IOIPSL
    55945582
    55955583    ! Recupere des varibles calcule dans differents modules
    … …  
    56515639    END IF
    56525640
    5653 #endif
    56545641    ! Petit appelle de sorties pour accompagner le travail sur phyex
    56555642    if (iflag_physiq == 1) then
    5656       call output_physiqex(debut, jD_eq, pdtphys, presnivs, paprs, u, v, t, qx, cldfra, 0. * t, 0. * t, 0. * t, pbl_tke, theta)
     5643      CALL output_physiqex(debut, jD_eq, pdtphys, presnivs, paprs, u, v, t, qx, cldfra, 0. * t, 0. * t, 0. * t, pbl_tke, theta)
    56575644    endif
    56585645
    … …  
    56955682      IF (using_xios) THEN
    56965683
    5697         IF (CPPKEY_INCA) THEN
    56985684          IF (type_trac == 'inca') THEN
    56995685            IF (is_omp_master .AND. grid_type==unstructured) THEN
    57005686              CALL finalize_inca
    57015687            ENDIF
    5702           ENDIF
    57035688        END IF
    57045689
    … …  
    57105695    ENDIF
    57115696
    5712     !      first=.false.
     5697    !      first=.FALSE.
    57135698
    57145699  END SUBROUTINE physiq
Note: See TracChangeset for help on using the changeset viewer.