Ignore:
Timestamp:
Dec 17, 2025, 7:33:39 PM (2 weeks ago)
Author:
yann meurdesoif
Message:

Separate pbl_surface into 3 subroutines for GPU port

pbl_surface_uncompress_pre : prepare computation for sub subsurface before compressing
pbl_surface_subsrf : each sub-surface is called one after other (horizontal = knon)
pbl_surface_uncompress_post : sub-surface are uncompressed, computation is done on whole domain (horizontal = klon)

pbl_surface_main becomes the driver, calling pbl_surface_uncompress_pre, and then looping under sub-surface (and calling pbl_surface_subsrf) and then calling pbl_surface_uncompress_post.

merge of commit r5868

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/climb_qbs_mod.f90

    r5400 r5942  
    2323!****************************************************************************************
    2424!
    25   SUBROUTINE climb_qbs_down(knon, coefqbs, paprs, pplay, &
     25  SUBROUTINE climb_qbs_down(knon, ni, coefqbs, paprs, pplay, &
    2626       delp, temp, qbs, dtime, &
    2727       Ccoef_QBS_out, Dcoef_QBS_out, &
    … …  
    3737!****************************************************************************************
    3838    INTEGER, INTENT(IN)                      :: knon
    39     REAL, DIMENSION(klon,klev), INTENT(IN)   :: coefqbs
    40     REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
    41     REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
    42     REAL, DIMENSION(klon,klev), INTENT(IN)   :: delp 
    43     REAL, DIMENSION(klon,klev), INTENT(IN)   :: temp
    44     REAL, DIMENSION(klon,klev), INTENT(IN)   :: qbs
     39    INTEGER, INTENT(IN)                      :: ni(knon)
     40    REAL, DIMENSION(knon,klev), INTENT(IN)   :: coefqbs
     41    REAL, DIMENSION(knon,klev), INTENT(IN)   :: pplay
     42    REAL, DIMENSION(knon,klev+1), INTENT(IN) :: paprs
     43    REAL, DIMENSION(knon,klev), INTENT(IN)   :: delp 
     44    REAL, DIMENSION(knon,klev), INTENT(IN)   :: temp
     45    REAL, DIMENSION(knon,klev), INTENT(IN)   :: qbs
    4546    REAL, INTENT(IN)                         :: dtime
    4647
    4748! Output arguments
    4849!****************************************************************************************
    49     REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef_QBS_out
    50     REAL, DIMENSION(klon), INTENT(OUT)       :: Bcoef_QBS_out
    51 
    52     REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef_QBS_out
    53     REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Dcoef_QBS_out
    54     REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Kcoef_qbs_out
    55     REAL, DIMENSION(klon,klev), INTENT(OUT)  :: gama_qbs_out
     50    REAL, DIMENSION(knon), INTENT(OUT)       :: Acoef_QBS_out
     51    REAL, DIMENSION(knon), INTENT(OUT)       :: Bcoef_QBS_out
     52
     53    REAL, DIMENSION(knon,klev), INTENT(OUT)  :: Ccoef_QBS_out
     54    REAL, DIMENSION(knon,klev), INTENT(OUT)  :: Dcoef_QBS_out
     55    REAL, DIMENSION(knon,klev), INTENT(OUT)  :: Kcoef_qbs_out
     56    REAL, DIMENSION(knon,klev), INTENT(OUT)  :: gama_qbs_out
    5657
    5758! Local variables
    5859!****************************************************************************************
     60    REAL :: yCcoef_QBS(knon,klev)
     61    REAL :: yDcoef_QBS(knon,klev)
     62    REAL :: yAcoef_QBS(knon), yBcoef_QBS(knon)
     63    REAL :: yKcoefqbs(knon,klev)
     64    REAL :: ygamaqbs(1:knon,2:klev)
     65
    5966    LOGICAL, SAVE                            :: first=.TRUE.
    6067    !$OMP THREADPRIVATE(first)
    61     REAL, DIMENSION(klon)                    :: psref
     68    REAL, DIMENSION(knon)                    :: psref
    6269    REAL                                     :: delz, pkh
    63     INTEGER                                  :: k, i, ierr
     70    INTEGER                                  :: k, i, j, ierr
    6471!****************************************************************************************
    6572! 1)
    … …  
    9299!
    93100!****************************************************************************************
    94     Kcoefqbs(:,:) = 0.0
     101    yKcoefqbs(:,:) = 0.0
    95102    DO k = 2, klev
    96103       DO i = 1, knon
    97           Kcoefqbs(i,k) = &
     104          yKcoefqbs(i,k) = &
    98105               coefqbs(i,k)*RG*RG*dtime /(pplay(i,k-1)-pplay(i,k)) &
    99106               *(paprs(i,k)*2/(temp(i,k)+temp(i,k-1))/RD)**2
    … …  
    111118!   definition of gama
    112119    IF (iflag_pbl == 1) THEN
    113        gamaqbs(:,:) = 0.0
     120       ygamaqbs(:,:) = 0.0
    114121 
    115122! conversion de gama
    … …  
    121128         
    122129! convertie gradient verticale de contenu en neige soufflee en difference de neige soufflee entre centre de couches
    123              gamaqbs(i,k) = gamaqbs(i,k) * delz   
     130             ygamaqbs(i,k) = ygamaqbs(i,k) * delz   
    124131          ENDDO
    125132       ENDDO
    126133
    127134    ELSE
    128        gamaqbs(:,:) = 0.0
     135       ygamaqbs(:,:) = 0.0
    129136    ENDIF
    130137   
    … …  
    136143!****************************************************************************************
    137144   
    138     CALL calc_coef_qbs(knon, Kcoefqbs(:,:), gamaqbs(:,:), delp(:,:), qbs(:,:), &
    139          Ccoef_QBS(:,:), Dcoef_QBS(:,:), Acoef_QBS, Bcoef_QBS)
     145    CALL calc_coef_qbs(knon, yKcoefqbs(:,:), ygamaqbs(:,:), delp(:,:), qbs(:,:), &
     146         yCcoef_QBS(:,:), yDcoef_QBS(:,:), yAcoef_QBS, yBcoef_QBS)
    140147
    141148 
    … …  
    145152!
    146153!****************************************************************************************
    147     Acoef_QBS_out = Acoef_QBS
    148     Bcoef_QBS_out = Bcoef_QBS
     154    Acoef_QBS_out = yAcoef_QBS
     155    Bcoef_QBS_out = yBcoef_QBS
    149156
    150157!****************************************************************************************
    … …  
    155162    IF (mod(iflag_pbl_split,10) .ge.1) THEN
    156163    DO k= 1, klev
    157       DO i= 1, klon
    158         Ccoef_QBS_out(i,k) = Ccoef_QBS(i,k)
    159         Dcoef_QBS_out(i,k) = Dcoef_QBS(i,k)
    160         Kcoef_qbs_out(i,k) = Kcoefqbs(i,k)
     164      DO i= 1, knon
     165        Ccoef_QBS_out(i,k) = yCcoef_QBS(i,k)
     166        Dcoef_QBS_out(i,k) = yDcoef_QBS(i,k)
     167        Kcoef_qbs_out(i,k) = yKcoefqbs(i,k)
    161168          IF (k.eq.1) THEN
    162169            gama_qbs_out(i,k)  = 0.
    163170          ELSE
    164             gama_qbs_out(i,k)  = gamaqbs(i,k)
     171            gama_qbs_out(i,k)  = ygamaqbs(i,k)
    165172          ENDIF
    166173      ENDDO
    … …  
    169176       ENDIF  ! (mod(iflag_pbl_split,2) .ge.1)
    170177!!!
     178    DO k= 1, klev
     179      DO j= 1, knon
     180        i=ni(j)
     181        IF (k==1) THEN
     182          Acoef_QBS(i) = yAcoef_QBS(j)
     183          Bcoef_QBS(i) = yBcoef_QBS(j)
     184        ENDIF
     185        IF (k>=2) gamaqbs(i,k)=ygamaqbs(j,k)
     186        Ccoef_QBS(i,k) = yCcoef_QBS(j,k)
     187        Dcoef_QBS(i,k) = yDcoef_QBS(j,k)
     188        Kcoefqbs(i,k) = yKcoefqbs(j,k)
     189      ENDDO
     190    ENDDO
    171191
    172192  END SUBROUTINE climb_qbs_down
    … …  
    182202!****************************************************************************************
    183203    INTEGER, INTENT(IN)                      :: knon
    184     REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef, delp
    185     REAL, DIMENSION(klon,klev), INTENT(IN)   :: X
    186     REAL, DIMENSION(klon,2:klev), INTENT(IN) :: gama
     204    REAL, DIMENSION(knon,klev), INTENT(IN)   :: Kcoef, delp
     205    REAL, DIMENSION(knon,klev), INTENT(IN)   :: X
     206    REAL, DIMENSION(knon,2:klev), INTENT(IN) :: gama
    187207
    188208! Output arguments
    189209!****************************************************************************************
    190     REAL, DIMENSION(klon), INTENT(OUT)       :: Acoef, Bcoef
    191     REAL, DIMENSION(klon,klev), INTENT(OUT)  :: Ccoef, Dcoef
     210    REAL, DIMENSION(knon), INTENT(OUT)       :: Acoef, Bcoef
     211    REAL, DIMENSION(knon,klev), INTENT(OUT)  :: Ccoef, Dcoef
    192212
    193213! Local variables
    … …  
    240260!****************************************************************************************
    241261!
    242   SUBROUTINE climb_qbs_up(knon, dtime, qbs_old, &
     262  SUBROUTINE climb_qbs_up(knon, ni, dtime, qbs_old, &
    243263       flx_qbs1, paprs, pplay, &
    244264       Acoef_QBS_in, Bcoef_QBS_in, &
    … …  
    257277!****************************************************************************************
    258278    INTEGER, INTENT(IN)                      :: knon
     279    INTEGER, INTENT(IN)                      :: ni(knon)
    259280    REAL, INTENT(IN)                         :: dtime
    260     REAL, DIMENSION(klon,klev), INTENT(IN)   :: qbs_old
    261     REAL, DIMENSION(klon), INTENT(IN)        :: flx_qbs1
    262     REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
    263     REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
     281    REAL, DIMENSION(knon,klev), INTENT(IN)   :: qbs_old
     282    REAL, DIMENSION(knon), INTENT(IN)        :: flx_qbs1
     283    REAL, DIMENSION(knon,klev+1), INTENT(IN) :: paprs
     284    REAL, DIMENSION(knon,klev), INTENT(IN)   :: pplay
    264285
    265286!!! nrlmd le 02/05/2011
    266     REAL, DIMENSION(klon), INTENT(IN)        :: Acoef_QBS_in, Bcoef_QBS_in
    267     REAL, DIMENSION(klon,klev), INTENT(IN)   :: Ccoef_QBS_in, Dcoef_QBS_in
    268     REAL, DIMENSION(klon,klev), INTENT(IN)   :: Kcoef_qbs_in, gama_qbs_in
     287    REAL, DIMENSION(knon), INTENT(IN)        :: Acoef_QBS_in, Bcoef_QBS_in
     288    REAL, DIMENSION(knon,klev), INTENT(IN)   :: Ccoef_QBS_in, Dcoef_QBS_in
     289    REAL, DIMENSION(knon,klev), INTENT(IN)   :: Kcoef_qbs_in, gama_qbs_in
    269290!!!
    270291
    271292! Output arguments
    272293!****************************************************************************************
    273     REAL, DIMENSION(klon,klev), INTENT(OUT)  :: flux_qbs, d_qbs
     294    REAL, DIMENSION(knon,klev), INTENT(OUT)  :: flux_qbs, d_qbs
    274295
    275296! Local variables
    276297!****************************************************************************************
     298    REAL :: yCcoef_QBS(knon,klev)
     299    REAL :: yDcoef_QBS(knon,klev)
     300    REAL :: yAcoef_QBS(knon), yBcoef_QBS(knon)
     301    REAL :: yKcoefqbs(knon,klev)
     302    REAL :: ygamaqbs(1:knon,2:klev)
     303
    277304    LOGICAL, SAVE                            :: last=.FALSE.
    278305!$OMP THREADPRIVATE(last)
    279     REAL, DIMENSION(klon,klev)               :: qbs_new
    280     REAL, DIMENSION(klon)                    :: psref         
    281     INTEGER                                  :: k, i, ierr
     306    REAL, DIMENSION(knon,klev)               :: qbs_new
     307    REAL, DIMENSION(knon)                    :: psref         
     308    INTEGER                                  :: k, i, j, ierr
    282309!****************************************************************************************
    283310! 1)
    284311! Definition of some variables
    285     REAL, DIMENSION(klon,klev)               :: zairm
     312    REAL, DIMENSION(knon,klev)               :: zairm
    286313!
    287314!****************************************************************************************
    … …  
    291318    psref(1:knon) = paprs(1:knon,1) 
    292319
     320    DO k= 1, klev
     321      DO j= 1, knon
     322        i=ni(j)
     323        IF (k==1) THEN
     324          yAcoef_QBS(j) = Acoef_QBS(i)
     325          yBcoef_QBS(j) = Bcoef_QBS(i)
     326        ENDIF
     327        IF (k>=2) ygamaqbs(j,k)=gamaqbs(i,k)
     328        yCcoef_QBS(j,k) = Ccoef_QBS(i,k)
     329        yDcoef_QBS(j,k) = Dcoef_QBS(i,k)
     330        yKcoefqbs(j,k) = Kcoefqbs(i,k)
     331      ENDDO
     332    ENDDO
     333
    293334       IF (mod(iflag_pbl_split,10) .ge.1) THEN
    294335    DO i = 1, knon
    295       Acoef_QBS(i)=Acoef_QBS_in(i)
    296       Bcoef_QBS(i)=Bcoef_QBS_in(i)
     336      yAcoef_QBS(i)=Acoef_QBS_in(i)
     337      yBcoef_QBS(i)=Bcoef_QBS_in(i)
    297338    ENDDO
    298339    DO k = 1, klev
    299340      DO i = 1, knon
    300         Ccoef_QBS(i,k)=Ccoef_QBS_in(i,k)
    301         Dcoef_QBS(i,k)=Dcoef_QBS_in(i,k)
    302         Kcoefqbs(i,k)=Kcoef_qbs_in(i,k)
     341        yCcoef_QBS(i,k)=Ccoef_QBS_in(i,k)
     342        yDcoef_QBS(i,k)=Dcoef_QBS_in(i,k)
     343        yKcoefqbs(i,k)=Kcoef_qbs_in(i,k)
    303344          IF (k.gt.1) THEN
    304             gamaqbs(i,k)=gama_qbs_in(i,k)
     345            ygamaqbs(i,k)=gama_qbs_in(i,k)
    305346          ENDIF
    306347      ENDDO
    … …  
    317358
    318359!- First layer
    319     qbs_new(1:knon,1) = Acoef_QBS(1:knon) + Bcoef_QBS(1:knon)*flx_qbs1(1:knon)*dtime
     360    qbs_new(1:knon,1) = yAcoef_QBS(1:knon) + yBcoef_QBS(1:knon)*flx_qbs1(1:knon)*dtime
    320361!- All the other layers
    321362    DO k = 2, klev
    322363       DO i = 1, knon
    323           qbs_new(i,k) = Ccoef_QBS(i,k) + Dcoef_QBS(i,k)*qbs_new(i,k-1)
     364          qbs_new(i,k) = yCcoef_QBS(i,k) + yDcoef_QBS(i,k)*qbs_new(i,k-1)
    324365       END DO
    325366    END DO
    … …  
    336377    DO k = 2, klev
    337378       DO i = 1, knon
    338           flux_qbs(i,k) = (Kcoefqbs(i,k)/RG/dtime) * &
    339                (qbs_new(i,k)-qbs_new(i,k-1)+gamaqbs(i,k))
     379          flux_qbs(i,k) = (yKcoefqbs(i,k)/RG/dtime) * &
     380               (qbs_new(i,k)-qbs_new(i,k-1)+ygamaqbs(i,k))
    340381       END DO
    341382    END DO
    … …  
    353394    END DO
    354395
     396    DO k= 1, klev
     397      DO j= 1, knon
     398        i=ni(j)
     399        IF (k==1) THEN
     400          Acoef_QBS(i) = yAcoef_QBS(j)
     401          Bcoef_QBS(i) = yBcoef_QBS(j)
     402        ENDIF
     403        IF (k>=2) gamaqbs(i,k)=ygamaqbs(j,k)
     404        Ccoef_QBS(i,k) = yCcoef_QBS(j,k)
     405        Dcoef_QBS(i,k) = yDcoef_QBS(j,k)
     406        Kcoefqbs(i,k) = yKcoefqbs(j,k)
     407      ENDDO
     408    ENDDO
    355409!****************************************************************************************
    356410! Some deallocations
Note: See TracChangeset for help on using the changeset viewer.