Ignore:
Timestamp:
Oct 21, 2024, 2:58:45 PM (23 hours ago)
Author:
abarral
Message:

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3dmem/laplacien_gam_loc.f90

    r5245 r5246  
    1       SUBROUTINE laplacien_gam_loc ( klevel, cuvsga, cvusga, unsaigam,
    2      *                        unsapolnga, unsapolsga, teta, divgra )
     1SUBROUTINE laplacien_gam_loc ( klevel, cuvsga, cvusga, unsaigam, &
     2        unsapolnga, unsapolsga, teta, divgra )
    33
    4 c  P. Le Van
    5 c
    6 c   ************************************************************
    7 c
    8 c      ....   calcul de  (div( grad ))   de   teta  .....
    9 c   ************************************************************
    10 c    klevel et teta  sont des arguments  d'entree pour le s-prog
    11 c      divgra     est  un argument  de sortie pour le s-prog
    12 c
    13       USE parallel_lmdz
    14       IMPLICIT NONE
    15 c
    16       INCLUDE "dimensions.h"
    17       INCLUDE "paramet.h"
    18       INCLUDE "comgeom.h"
     4  !  P. Le Van
     5  !
     6  !   ************************************************************
     7  !
     8  !  ....   calcul de  (div( grad ))   de   teta  .....
     9  !   ************************************************************
     10  !    klevel et teta  sont des arguments  d'entree pour le s-prog
     11  !  divgra     est  un argument  de sortie pour le s-prog
     12  !
     13  USE parallel_lmdz
     14  IMPLICIT NONE
     15  !
     16  INCLUDE "dimensions.h"
     17  INCLUDE "paramet.h"
     18  INCLUDE "comgeom.h"
    1919
    20 c
    21 c    ............     variables  en arguments    ..........
    22 c
    23       INTEGER klevel
    24       REAL teta( ijb_u:ije_u,klevel ), divgra( ijb_u:ije_u,klevel )
    25       REAL cuvsga(ip1jm) , cvusga( ip1jmp1 )
    26       REAL unsaigam(ip1jmp1)
    27       REAL unsapolnga, unsapolsga
    28 c
    29 c    ...........    variables  locales    .................
    30 c
    31       REAL ghy(ijb_v:ije_v,llm), ghx(ijb_u:ije_u,llm)
    32 c    ......................................................
     20  !
     21  !    ............     variables  en arguments    ..........
     22  !
     23  INTEGER :: klevel
     24  REAL :: teta( ijb_u:ije_u,klevel ), divgra( ijb_u:ije_u,klevel )
     25  REAL :: cuvsga(ip1jm) , cvusga( ip1jmp1 )
     26  REAL :: unsaigam(ip1jmp1)
     27  REAL :: unsapolnga, unsapolsga
     28  !
     29  !    ...........    variables  locales    .................
     30  !
     31  REAL :: ghy(ijb_v:ije_v,llm), ghx(ijb_u:ije_u,llm)
     32  !    ......................................................
    3333
    34       INTEGER :: ijb,ije
    35       INTEGER :: l     
    36 c
    37 c
    38 c   ...  cvuscugam  = ( cvu/ cu ) ** (- gamdissip )
    39 c   ...  cuvscvgam  = ( cuv/ cv ) ** (- gamdissip )  calcules dans inigeom  ..
    40 c   ...  unsairegam =  1. /  aire ** (- gamdissip )
    41 c
     34  INTEGER :: ijb,ije
     35  INTEGER :: l
     36  !
     37  !
     38  !   ...  cvuscugam  = ( cvu/ cu ) ** (- gamdissip )
     39  !   ...  cuvscvgam  = ( cuv/ cv ) ** (- gamdissip )  calcules dans inigeom  ..
     40  !   ...  unsairegam =  1. /  aire ** (- gamdissip )
     41  !
    4242
    43 c      CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
    44      
    45       ijb=ij_begin-iip1
    46       ije=ij_end+iip1
    47       if (pole_nord) ijb=ij_begin
    48       if (pole_sud ) ije=ij_end
    49      
    50 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    51       DO l=1,klevel     
    52         divgra(ijb:ije,l)=teta(ijb:ije,l)
    53       ENDDO
    54 c$OMP END DO NOWAIT
     43  !  CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
    5544
    56 c
    57       CALL   grad_loc ( klevel, divgra, ghx, ghy )
    58 c
    59       CALL  diverg_gam_loc ( klevel, cuvsga, cvusga,  unsaigam  ,
    60      *                 unsapolnga, unsapolsga, ghx , ghy , divgra )
     45  ijb=ij_begin-iip1
     46  ije=ij_end+iip1
     47  if (pole_nord) ijb=ij_begin
     48  if (pole_sud ) ije=ij_end
    6149
    62 c
     50!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     51  DO l=1,klevel
     52    divgra(ijb:ije,l)=teta(ijb:ije,l)
     53  ENDDO
     54!$OMP END DO NOWAIT
    6355
    64       RETURN
    65       END
     56  !
     57  CALL   grad_loc ( klevel, divgra, ghx, ghy )
     58  !
     59  CALL  diverg_gam_loc ( klevel, cuvsga, cvusga,  unsaigam  , &
     60        unsapolnga, unsapolsga, ghx , ghy , divgra )
     61
     62  !
     63
     64  RETURN
     65END SUBROUTINE laplacien_gam_loc
Note: See TracChangeset for help on using the changeset viewer.