Changeset 5696


Ignore:
Timestamp:
Jun 13, 2025, 8:19:58 PM (4 weeks ago)
Author:
yann meurdesoif
Message:

Convection GPU porting : separate initialisation phase of computing phase for cva_driver and cv3_routines (remove saved first/debut variable type from computing routine)
YM

Location:
LMDZ6/trunk/libf/phylmd
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/phylmd/concvl.f90

    r5693 r5696  
    4040  USE conema3_mod_h
    4141  USE yoethf_mod_h
    42   USE cva_driver_mod, ONLY : cva_driver
     42  USE cva_driver_mod, ONLY : cva_driver_pre, cva_driver, cva_driver_post
    4343  IMPLICIT NONE
    4444! ======================================================================
     
    421421!LF   necessary for gathered fields
    422422    nloc = klon
     423    CALL cva_driver_pre(klev, k_upper_cv, iflag_con, iflag_ice_thermo, ok_conserv_q, dtime )
    423424    CALL cva_driver(klon, klev, klev+1, ntra, nloc, k_upper_cv, &
    424425                    iflag_con, iflag_mix, iflag_ice_thermo, &
     
    445446!AC!+!RomP+jyg
    446447                    epmax_diag) ! epmax_cape
     448    CALL cva_driver_post
    447449  END IF
    448450! ------------------------------------------------------------------
  • LMDZ6/trunk/libf/phylmd/cv3_routines.f90

    r5695 r5696  
    33MODULE cv3_routines_mod
    44  PRIVATE
    5 
     5! for cv3_feed
     6  LOGICAL, SAVE :: cv3_feed_first =.TRUE.
     7  LOGICAL, SAVE :: ok_new_feed
     8!$OMP THREADPRIVATE (first,ok_new_feed)
    69  PUBLIC cv3_param, cv3_incrcount, cv3_prelim, cv3_feed, cv3_undilute1, cv3_trigger, cv3_compress, &
    710         icefrac, cv3_undilute2, cv3_closure, cv3_mixing, cv3_unsat, cv3_yield, cv3_tracer, cv3_uncompress,&
    8          cv3_epmax_fn_cape
     11         cv3_epmax_fn_cape, cv3_routine_pre
    912CONTAINS
    1013
    11 
    12 
     14SUBROUTINE cv3_routine_pre(ok_conserv_q)
     15  LOGICAL, INTENT (IN)                               :: ok_conserv_q
     16 
     17  CALL cv3_feed_pre(ok_conserv_q)
     18
     19END SUBROUTINE cv3_routine_pre
    1320
    1421SUBROUTINE cv3_param(nd, k_upper, delt)
     
    314321END SUBROUTINE cv3_prelim
    315322
     323
     324SUBROUTINE cv3_feed_pre(ok_conserv_q)
     325USE mod_phys_lmdz_transfert_para, ONLY : bcast
     326IMPLICIT NONE
     327  LOGICAL, INTENT (IN)                               :: ok_conserv_q
     328  INTEGER :: iostat
     329
     330  IF (cv3_feed_first) THEN
     331
     332!$OMP MASTER
     333    ok_new_feed = ok_conserv_q
     334    OPEN (98, FILE='cv3feed_param.data', STATUS='old', FORM='formatted', IOSTAT=iostat)
     335    IF (iostat==0) THEN
     336      READ (98, *, END=998) ok_new_feed
     337998   CONTINUE
     338      CLOSE (98)
     339    END IF
     340    PRINT *, ' ok_new_feed: ', ok_new_feed
     341!$OMP END MASTER
     342    call bcast(ok_new_feed)
     343    cv3_feed_first = .FALSE.   
     344  END IF
     345
     346END SUBROUTINE cv3_feed_pre
     347
     348
    316349SUBROUTINE cv3_feed(len, nd, ok_conserv_q, &
    317350                    t, q, u, v, p, ph, h, gz, &
     
    320353                    cpnk, hnk, nk, icb, icbmax, iflag, gznk, plcl)
    321354
    322   USE mod_phys_lmdz_transfert_para, ONLY : bcast
    323355  USE add_phys_tend_mod, ONLY: fl_cor_ebil
    324356  USE print_control_mod, ONLY: prt_level
     
    374406
    375407!jyg20140217<
    376   INTEGER iostat
    377   LOGICAL, SAVE :: first
    378   LOGICAL, SAVE :: ok_new_feed
    379   REAL, SAVE :: dp_lcl_feed
    380 !$OMP THREADPRIVATE (first,ok_new_feed,dp_lcl_feed)
    381   DATA first/.TRUE./
    382   DATA dp_lcl_feed/2./
    383 
    384   IF (first) THEN
    385 !$OMP MASTER
    386     ok_new_feed = ok_conserv_q
    387     OPEN (98, FILE='cv3feed_param.data', STATUS='old', FORM='formatted', IOSTAT=iostat)
    388     IF (iostat==0) THEN
    389       READ (98, *, END=998) ok_new_feed
    390 998   CONTINUE
    391       CLOSE (98)
    392     END IF
    393     PRINT *, ' ok_new_feed: ', ok_new_feed
    394 !$OMP END MASTER
    395     call bcast(ok_new_feed)
    396     first = .FALSE.   
    397   END IF
     408  REAL, PARAMETER :: dp_lcl_feed = 2.
     409
    398410!jyg>
    399411! -------------------------------------------------------------------
  • LMDZ6/trunk/libf/phylmd/cva_driver.f90

    r5694 r5696  
    44MODULE cva_driver_mod
    55  PRIVATE
    6 
    7   PUBLIC cva_driver
     6  LOGICAL, SAVE :: debut = .TRUE.
     7  !$OMP THREADPRIVATE(debut)
     8
     9  PUBLIC cva_driver_pre, cva_driver_post, cva_driver
    810
    911CONTAINS
     12
     13! called before cva_driver
     14SUBROUTINE cva_driver_pre(nd, k_upper, iflag_con, iflag_ice_thermo, ok_conserv_q, delt)
     15USE cv3_routines_mod, ONLY : cv3_routine_pre, cv3_param 
     16USE cv_routines_mod, ONLY : cv_param
     17USE ioipsl_getin_p_mod, ONLY : getin_p
     18USE s2s
     19IMPLICIT NONE
     20  INTEGER, INTENT (IN)                               :: nd
     21  INTEGER, INTENT (IN)                               :: k_upper
     22  INTEGER, INTENT (IN)                               :: iflag_con
     23  INTEGER, INTENT (IN)                               :: iflag_ice_thermo
     24  REAL, INTENT (IN)                                  :: delt
     25  LOGICAL, INTENT (IN)                               :: ok_conserv_q
     26
     27  IF (debut) THEN
     28    ! -------------------------------------------------------------------
     29    ! --- SET CONSTANTS AND PARAMETERS
     30    ! -------------------------------------------------------------------
     31
     32    ! -- set simulation flags:
     33    ! (common cvflag)
     34    CALL cv_flag(iflag_ice_thermo)
     35
     36    ! -- set thermodynamical constants:
     37    ! (common cvthermo)
     38
     39    CALL cv_thermo(iflag_con)
     40
     41    ! -- set convect parameters
     42
     43    ! includes microphysical parameters and parameters that
     44    ! control the rate of approach to quasi-equilibrium)
     45    ! (common cvparam)
     46
     47    IF (iflag_con==3) THEN
     48      CALL cv3_param(nd, k_upper, delt)
     49    END IF
     50
     51    IF (iflag_con==4) THEN
     52      CALL cv_param(nd)
     53    END IF
     54   
     55    CALL cv3_routine_pre(ok_conserv_q)
     56  ENDIF
     57
     58END SUBROUTINE cva_driver_pre
     59
     60!called after cva_driver
     61SUBROUTINE cva_driver_post
     62IMPLICIT NONE
     63  IF (debut) THEN
     64    debut=.FALSE.
     65  ENDIF
     66END SUBROUTINE cva_driver_post
    1067
    1168SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, k_upper, &
     
    435492
    436493  LOGICAL ok_inhib ! True => possible inhibition of convection by dryness
    437   LOGICAL, SAVE :: debut = .TRUE.
    438 !$OMP THREADPRIVATE(debut)
    439494
    440495  REAL coef_convective(len)   ! = 1 for convective points, = 0 otherwise
     
    573628! print *, 'q1, q1_wake ',(k,q1(1,k),q1_wake(1,k),k=1,nd)
    574629
    575 ! -------------------------------------------------------------------
    576 ! --- SET CONSTANTS AND PARAMETERS
    577 ! -------------------------------------------------------------------
    578 
    579 ! -- set simulation flags:
    580 ! (common cvflag)
    581 
    582   CALL cv_flag(iflag_ice_thermo)
    583 
    584 ! -- set thermodynamical constants:
    585 ! (common cvthermo)
    586 
    587   CALL cv_thermo(iflag_con)
    588 
    589 ! -- set convect parameters
    590 
    591 ! includes microphysical parameters and parameters that
    592 ! control the rate of approach to quasi-equilibrium)
    593 ! (common cvparam)
    594 
    595   IF (iflag_con==3) THEN
    596     CALL cv3_param(nd, k_upper, delt)
    597 
    598   END IF
    599 
    600   IF (iflag_con==4) THEN
    601     CALL cv_param(nd)
    602   END IF
     630
    603631
    604632! ---------------------------------------------------------------------
     
    13001328  IF (debut) THEN
    13011329    PRINT *, ' cv_uncompress -> '
    1302     debut = .FALSE.
    13031330  END IF  !(debut) THEN
    13041331
Note: See TracChangeset for help on using the changeset viewer.