Ignore:
Timestamp:
Oct 21, 2024, 2:58:45 PM (22 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/dyn3d_common/test_period.f90

    r5245 r5246  
    22! $Header$
    33!
    4       SUBROUTINE test_period ( ucov, vcov, teta, q, p, phis )
    5 c
    6 c     Auteur : P. Le Van 
    7 c    ---------
    8 c  ....  Cette routine teste la periodicite en longitude des champs   ucov,
    9 c                           teta, q , p et phis                 ..........
    10 c
    11       USE infotrac, ONLY : nqtot
    12 c
    13 c    IMPLICIT NONE
    14 c
    15       INCLUDE "dimensions.h"
    16       INCLUDE "paramet.h"
    17 c
    18 c    ......  Arguments   ......
    19 c
    20       REAL ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) ,
    21      ,      q(ip1jmp1,llm,nqtot), p(ip1jmp1,llmp1), phis(ip1jmp1)
    22 c
    23 c   .....  Variables  locales  .....
    24 c
    25       INTEGER ij,l,nq
    26 c
    27       DO l = 1, llm
    28          DO ij = 1, ip1jmp1, iip1
    29           IF( ucov(ij,l).NE.ucov(ij+iim,l) )  THEN
    30           PRINT *,'STOP dans test_period car ---  UCOV  ---  n est pas', 
    31      ,  ' periodique en longitude ! '
    32           PRINT *,' l,  ij = ', l, ij, ij+iim
    33           STOP
    34           ENDIF
    35           IF( teta(ij,l).NE.teta(ij+iim,l) )  THEN
    36           PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', 
    37      ,   ' periodique en longitude ! '
    38           PRINT *,' l,  ij = ', l, ij, ij+iim
    39      ,      , teta(ij,l),   teta(ij+iim,l)
    40           STOP
    41           ENDIF
    42          ENDDO
     4SUBROUTINE test_period ( ucov, vcov, teta, q, p, phis )
     5  !
     6  ! Auteur : P. Le Van
     7  !    ---------
     8  !  ....  Cette routine teste la periodicite en longitude des champs   ucov,
     9  !                       teta, q , p et phis                 ..........
     10  !
     11  USE infotrac, ONLY : nqtot
     12  !
     13  ! IMPLICIT NONE
     14  !
     15  INCLUDE "dimensions.h"
     16  INCLUDE "paramet.h"
     17  !
     18  !    ......  Arguments   ......
     19  !
     20  REAL :: ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) , &
     21        q(ip1jmp1,llm,nqtot), p(ip1jmp1,llmp1), phis(ip1jmp1)
     22  !
     23  !   .....  Variables  locales  .....
     24  !
     25  INTEGER :: ij,l,nq
     26  !
     27  DO l = 1, llm
     28     DO ij = 1, ip1jmp1, iip1
     29      IF( ucov(ij,l).NE.ucov(ij+iim,l) )  THEN
     30      PRINT *,'STOP dans test_period car ---  UCOV  ---  n est pas', &
     31            ' periodique en longitude ! '
     32      PRINT *,' l,  ij = ', l, ij, ij+iim
     33      STOP
     34      ENDIF
     35      IF( teta(ij,l).NE.teta(ij+iim,l) )  THEN
     36      PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', &
     37            ' periodique en longitude ! '
     38      PRINT *,' l,  ij = ', l, ij, ij+iim &
     39            , teta(ij,l),   teta(ij+iim,l)
     40      STOP
     41      ENDIF
     42     ENDDO
    4343
    44          do ij=1,iim
    45           if (teta(ij,l).ne.teta(1,l)
    46      s     .or.teta(ip1jm+ij,l).ne.teta(ip1jm+1,l) ) then
    47           PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', 
    48      ,  ' constant aux poles ! '
    49           print*,'teta(',1 ,',',l,')=',teta(1 ,l)
    50           print*,'teta(',ij,',',l,')=',teta(ij,l)
    51           print*,'teta(',ip1jm+1 ,',',l,')=',teta(ip1jm+1 ,l)
    52           print*,'teta(',ip1jm+ij,',',l,')=',teta(ip1jm+ij,l)
    53           stop
    54           endif
    55          enddo
     44     do ij=1,iim
     45      if (teta(ij,l).ne.teta(1,l) &
     46            .or.teta(ip1jm+ij,l).ne.teta(ip1jm+1,l) ) then
     47      PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', &
     48            ' constant aux poles ! '
     49      print*,'teta(',1 ,',',l,')=',teta(1 ,l)
     50      print*,'teta(',ij,',',l,')=',teta(ij,l)
     51      print*,'teta(',ip1jm+1 ,',',l,')=',teta(ip1jm+1 ,l)
     52      print*,'teta(',ip1jm+ij,',',l,')=',teta(ip1jm+ij,l)
     53      stop
     54      endif
     55     enddo
     56  ENDDO
     57
     58  !
     59  DO l = 1, llm
     60     DO ij = 1, ip1jm, iip1
     61      IF( vcov(ij,l).NE.vcov(ij+iim,l) )  THEN
     62      PRINT *,'STOP dans test_period car ---  VCOV  ---  n est pas', &
     63            ' periodique en longitude !'
     64      PRINT *,' l,  ij = ', l, ij, ij+iim,vcov(ij+iim,l),vcov(ij,l)
     65      vcov(ij+iim,l)=vcov(ij,l)
     66      ! STOP
     67      ENDIF
     68     ENDDO
     69  ENDDO
     70
     71  !
     72  DO nq =1, nqtot
     73    DO l =1, llm
     74      DO ij = 1, ip1jmp1, iip1
     75      IF( q(ij,l,nq).NE.q(ij+iim,l,nq) )  THEN
     76      PRINT *,'STOP dans test_period car ---  Q  ---  n est pas ', &
     77            'periodique en longitude !'
     78      PRINT *,' nq , l,  ij = ', nq, l, ij, ij+iim
     79      STOP
     80      ENDIF
    5681      ENDDO
    57 
    58 c
    59       DO l = 1, llm
    60          DO ij = 1, ip1jm, iip1
    61           IF( vcov(ij,l).NE.vcov(ij+iim,l) )  THEN
    62           PRINT *,'STOP dans test_period car ---  VCOV  ---  n est pas', 
    63      ,   ' periodique en longitude !'
    64           PRINT *,' l,  ij = ', l, ij, ij+iim,vcov(ij+iim,l),vcov(ij,l)
    65           vcov(ij+iim,l)=vcov(ij,l)
    66 c         STOP
    67           ENDIF
    68          ENDDO
    69       ENDDO
    70      
    71 c
    72       DO nq =1, nqtot
    73         DO l =1, llm
    74           DO ij = 1, ip1jmp1, iip1
    75           IF( q(ij,l,nq).NE.q(ij+iim,l,nq) )  THEN
    76           PRINT *,'STOP dans test_period car ---  Q  ---  n est pas ', 
    77      ,   'periodique en longitude !'
    78           PRINT *,' nq , l,  ij = ', nq, l, ij, ij+iim
    79           STOP
    80           ENDIF
    81           ENDDO
    82         ENDDO
    83       ENDDO
    84 c
    85        DO l = 1, llm
    86          DO ij = 1, ip1jmp1, iip1
    87           IF( p(ij,l).NE.p(ij+iim,l) )  THEN
    88           PRINT *,'STOP dans test_period car ---  P  ---  n est pas', 
    89      ,    ' periodique en longitude !'
    90           PRINT *,' l ij = ',l, ij, ij+iim
    91           STOP
    92           ENDIF
    93           IF( phis(ij).NE.phis(ij+iim) )  THEN
    94           PRINT *,'STOP dans test_period car ---  PHIS  ---  n est pas', 
    95      ,   ' periodique en longitude !  l, IJ = ', l, ij,ij+iim
    96           PRINT *,' ij = ', ij, ij+iim
    97           STOP
    98           ENDIF
    99          ENDDO
    100          do ij=1,iim
    101           if (p(ij,l).ne.p(1,l)
    102      s     .or.p(ip1jm+ij,l).ne.p(ip1jm+1,l) ) then
    103           PRINT *,'STOP dans test_period car ---  P     ---  n est pas', 
    104      ,  ' constant aux poles ! '
    105           print*,'p(',1 ,',',l,')=',p(1 ,l)
    106           print*,'p(',ij,',',l,')=',p(ij,l)
    107           print*,'p(',ip1jm+1 ,',',l,')=',p(ip1jm+1 ,l)
    108           print*,'p(',ip1jm+ij,',',l,')=',p(ip1jm+ij,l)
    109           stop
    110           endif
    111          enddo
    112        ENDDO
    113 c
    114 c
    115          RETURN
    116          END
     82    ENDDO
     83  ENDDO
     84  !
     85   DO l = 1, llm
     86     DO ij = 1, ip1jmp1, iip1
     87      IF( p(ij,l).NE.p(ij+iim,l) )  THEN
     88      PRINT *,'STOP dans test_period car ---  P  ---  n est pas', &
     89            ' periodique en longitude !'
     90      PRINT *,' l ij = ',l, ij, ij+iim
     91      STOP
     92      ENDIF
     93      IF( phis(ij).NE.phis(ij+iim) )  THEN
     94      PRINT *,'STOP dans test_period car ---  PHIS  ---  n est pas', &
     95            ' periodique en longitude !  l, IJ = ', l, ij,ij+iim
     96      PRINT *,' ij = ', ij, ij+iim
     97      STOP
     98      ENDIF
     99     ENDDO
     100     do ij=1,iim
     101      if (p(ij,l).ne.p(1,l) &
     102            .or.p(ip1jm+ij,l).ne.p(ip1jm+1,l) ) then
     103      PRINT *,'STOP dans test_period car ---  P     ---  n est pas', &
     104            ' constant aux poles ! '
     105      print*,'p(',1 ,',',l,')=',p(1 ,l)
     106      print*,'p(',ij,',',l,')=',p(ij,l)
     107      print*,'p(',ip1jm+1 ,',',l,')=',p(ip1jm+1 ,l)
     108      print*,'p(',ip1jm+ij,',',l,')=',p(ip1jm+ij,l)
     109      stop
     110      endif
     111     enddo
     112   ENDDO
     113  !
     114  !
     115     RETURN
     116END SUBROUTINE test_period
Note: See TracChangeset for help on using the changeset viewer.