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/rotat_p.f90

    r5245 r5246  
    1       SUBROUTINE rotat_p (klevel, x, y, rot )
    2 c
    3 c     Auteur : P.Le Van
    4 c**************************************************************
    5 c.  calcule le rotationnel
    6 c    a tous les niveaux d'1 vecteur de comp. x et y ..
    7 c       x  et  y etant des composantes  covariantes  ...
    8 c********************************************************************
    9 c   klevel, x  et y   sont des arguments d'entree pour le s-prog
    10 c        rot          est  un argument  de sortie pour le s-prog
    11 c
    12       USE parallel_lmdz
    13       IMPLICIT NONE
    14 c
    15       INCLUDE "dimensions.h"
    16       INCLUDE "paramet.h"
    17       INCLUDE "comgeom.h"
    18 c
    19 c   .....  variables en arguments  ......
    20 c
    21       INTEGER klevel
    22       REAL rot( ip1jm,klevel )
    23       REAL x( ip1jmp1,klevel ), y( ip1jm,klevel )
    24 c
    25 c  ...   variables  locales  ...
    26 c
    27       INTEGER l, ij
    28       INTEGER :: ijb,ije
    29 c
    30 c
    31       ijb=ij_begin
    32       ije=ij_end
    33       if(pole_sud) ije=ij_end-iip1
    34      
    35 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    36       DO  10 l = 1,klevel
    37 c
    38         DO   ij = ijb, ije - 1
    39          rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   +
    40      *                   x(ij +iip1, l )  -  x( ij,l ) 
    41         ENDDO
    42 c
    43 c    .... correction pour rot( iip1,j,l)  ....
    44 c    ....   rot(iip1,j,l)= rot(1,j,l) ...
    45 CDIR$ IVDEP
    46         DO  ij = ijb+iip1-1, ije, iip1
    47          rot( ij,l ) = rot( ij -iim,l )
    48         ENDDO
    49 c
    50   10  CONTINUE
    51 c$OMP END DO NOWAIT
    52 ccc        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
    53 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    54         DO l = 1, klevel
    55           DO ij = ijb, ije
    56            rot(ij,l) = rot(ij,l) * unsairez(ij)
    57           ENDDO
    58         ENDDO
    59 c$OMP END DO NOWAIT
    60 c
    61 c
    62       RETURN
    63       END
     1SUBROUTINE rotat_p (klevel, x, y, rot )
     2  !
     3  ! Auteur : P.Le Van
     4  !**************************************************************
     5  !.  calcule le rotationnel
     6  ! a tous les niveaux d'1 vecteur de comp. x et y ..
     7  !   x  et  y etant des composantes  covariantes  ...
     8  !********************************************************************
     9  !   klevel, x  et y   sont des arguments d'entree pour le s-prog
     10  !        rot          est  un argument  de sortie pour le s-prog
     11  !
     12  USE parallel_lmdz
     13  IMPLICIT NONE
     14  !
     15  INCLUDE "dimensions.h"
     16  INCLUDE "paramet.h"
     17  INCLUDE "comgeom.h"
     18  !
     19  !   .....  variables en arguments  ......
     20  !
     21  INTEGER :: klevel
     22  REAL :: rot( ip1jm,klevel )
     23  REAL :: x( ip1jmp1,klevel ), y( ip1jm,klevel )
     24  !
     25  !  ...   variables  locales  ...
     26  !
     27  INTEGER :: l, ij
     28  INTEGER :: ijb,ije
     29  !
     30  !
     31  ijb=ij_begin
     32  ije=ij_end
     33  if(pole_sud) ije=ij_end-iip1
     34
     35!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     36  DO l = 1,klevel
     37  !
     38    DO   ij = ijb, ije - 1
     39     rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   + &
     40           x(ij +iip1, l )  -  x( ij,l )
     41    ENDDO
     42  !
     43  !    .... correction pour rot( iip1,j,l)  ....
     44  !    ....   rot(iip1,j,l)= rot(1,j,l) ...
     45  !DIR$ IVDEP
     46    DO  ij = ijb+iip1-1, ije, iip1
     47     rot( ij,l ) = rot( ij -iim,l )
     48    ENDDO
     49  !
     50  END DO
     51!$OMP END DO NOWAIT
     52  !cc        CALL filtreg( rot, jjm, klevel, 2, 2, .FALSE., 1 )
     53!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     54    DO l = 1, klevel
     55      DO ij = ijb, ije
     56       rot(ij,l) = rot(ij,l) * unsairez(ij)
     57      ENDDO
     58    ENDDO
     59!$OMP END DO NOWAIT
     60  !
     61  !
     62  RETURN
     63END SUBROUTINE rotat_p
Note: See TracChangeset for help on using the changeset viewer.