Ignore:
Timestamp:
Jul 23, 2024, 7:14:34 PM (8 weeks ago)
Author:
abarral
Message:

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

File:
1 moved

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_gam_loc.f90

    r5104 r5105  
    1       SUBROUTINE nxgrad_gam_loc( klevel, rot, x, y )
    2 c
    3 c  P. Le Van
    4 c
    5 c   ********************************************************************
    6 c      calcul du gradient tourne de pi/2 du rotationnel du vect.v
    7 c   ********************************************************************
    8 c       rot          est un argument  d'entree pour le s-prog
    9 c       x  et y    sont des arguments de sortie pour le s-prog
    10 c
    11       USE parallel_lmdz
    12      
    13       IMPLICIT NONE
    14 c
    15       INCLUDE "dimensions.h"
    16       INCLUDE "paramet.h"
    17       INCLUDE "comgeom.h"
    18       INTEGER klevel
    19       REAL rot( ijb_v:ije_v,klevel )
    20       REAL x( ijb_u:ije_u,klevel ),y(ijb_v:ije_v,klevel )
    21       INTEGER   l,ij
    22       integer ismin,ismax
    23       external ismin,ismax
    24       INTEGER :: ijb,ije
    25 c
    26 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    27       DO l = 1,klevel
    28 c
    29       ijb=ij_begin
    30       ije=ij_end
    31       if(pole_sud) ije=ij_end-iip1
    32      
    33       DO ij = ijb+1, ije
    34       y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
    35       END DO
    36 c
    37 c    ..... correction pour  y ( 1,j,l )  ......
    38 c
    39 c    ....    y(1,j,l)= y(iip1,j,l) ....
    40 CDIR$ IVDEP
    41       DO ij = ijb, ije, iip1
    42       y( ij,l ) = y( ij +iim,l )
    43       END DO
    44 c
    45       ijb=ij_begin
    46       ije=ij_end+iip1
    47       if(pole_nord) ijb=ij_begin+iip1
    48       if(pole_sud) ije=ij_end-iip1
    49      
    50       DO ij = ijb,ije
    51       x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
    52       END DO
    53    
    54       if (pole_nord) then
    55         DO  ij = 1,iip1
    56          x(    ij    ,l ) = 0.
    57         ENDDO
    58       endif
     1SUBROUTINE nxgrad_gam_loc( klevel, rot, x, y )
     2  !
     3  !  P. Le Van
     4  !
     5  !   ********************************************************************
     6  !  calcul du gradient tourne de pi/2 du rotationnel du vect.v
     7  !   ********************************************************************
     8  !   rot          est un argument  d'entree pour le s-prog
     9  !   x  et y    sont des arguments de sortie pour le s-prog
     10  !
     11  USE parallel_lmdz
    5912
    60       if (pole_sud) then
    61         DO  ij = 1,iip1
    62          x( ij +ip1jm,l ) = 0.
    63         ENDDO
    64       endif
    65 c
    66       END DO
    67 c$OMP END DO NOWAIT
    68       RETURN
    69       END
     13  IMPLICIT NONE
     14  !
     15  INCLUDE "dimensions.h"
     16  INCLUDE "paramet.h"
     17  INCLUDE "comgeom.h"
     18  INTEGER :: klevel
     19  REAL :: rot( ijb_v:ije_v,klevel )
     20  REAL :: x( ijb_u:ije_u,klevel ),y(ijb_v:ije_v,klevel )
     21  INTEGER :: l,ij
     22  integer :: ismin,ismax
     23  external ismin,ismax
     24  INTEGER :: ijb,ije
     25  !
     26!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     27  DO l = 1,klevel
     28  !
     29  ijb=ij_begin
     30  ije=ij_end
     31  if(pole_sud) ije=ij_end-iip1
     32
     33  DO ij = ijb+1, ije
     34  y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
     35  END DO
     36  !
     37  !    ..... correction pour  y ( 1,j,l )  ......
     38  !
     39  !    ....    y(1,j,l)= y(iip1,j,l) ....
     40  !DIR$ IVDEP
     41  DO ij = ijb, ije, iip1
     42  y( ij,l ) = y( ij +iim,l )
     43  END DO
     44  !
     45  ijb=ij_begin
     46  ije=ij_end+iip1
     47  if(pole_nord) ijb=ij_begin+iip1
     48  if(pole_sud) ije=ij_end-iip1
     49
     50  DO ij = ijb,ije
     51  x( ij,l ) = (rot( ij,l ) - rot( ij -iip1,l )) * cuscvugam( ij )
     52  END DO
     53
     54  if (pole_nord) then
     55    DO  ij = 1,iip1
     56     x(    ij    ,l ) = 0.
     57    ENDDO
     58  endif
     59
     60  if (pole_sud) then
     61    DO  ij = 1,iip1
     62     x( ij +ip1jm,l ) = 0.
     63    ENDDO
     64  endif
     65  !
     66  END DO
     67!$OMP END DO NOWAIT
     68
     69END SUBROUTINE nxgrad_gam_loc
Note: See TracChangeset for help on using the changeset viewer.