Ignore:
Timestamp:
Jul 24, 2024, 6:46:45 PM (4 months ago)
Author:
abarral
Message:

enforce PRIVATE by default in several modules, expose PUBLIC as needed
move eigen.f90 to obsolete/
(lint) aslong the way

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d_common
Files:
19 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/com_io_dyn_mod.F90

    r5116 r5119  
    2929  INTEGER :: histuaveid
    3030 
    31 end module com_io_dyn_mod
     31END MODULE com_io_dyn_mod

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/divgrad.f90

    r5106 r5119  
    1 
    21! $Header$
    32
    4 SUBROUTINE divgrad(klevel,h, lh, divgra )
     3SUBROUTINE divgrad(klevel, h, lh, divgra)
    54  USE lmdz_filtreg, ONLY: filtreg
     5  USE lmdz_ssum_scopy, ONLY: scopy
    66  IMPLICIT NONE
    77  !
    … …  
    2727  !
    2828  INTEGER :: klevel
    29   REAL :: h( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
     29  REAL :: h(ip1jmp1, klevel), divgra(ip1jmp1, klevel)
    3030  !
    31   REAL :: ghy(ip1jm,llm), ghx(ip1jmp1,llm)
     31  REAL :: ghy(ip1jm, llm), ghx(ip1jmp1, llm)
    3232
    33   INTEGER :: l,ij,iter,lh
     33  INTEGER :: l, ij, iter, lh
    3434  !
    3535  !
    3636  !
    37   CALL SCOPY ( ip1jmp1*klevel,h,1,divgra,1 )
     37  CALL SCOPY (ip1jmp1 * klevel, h, 1, divgra, 1)
    3838  !
    39   DO iter = 1,lh
     39  DO iter = 1, lh
    4040
    41   CALL filtreg ( divgra,jjp1,klevel,2,1,.TRUE.,1  )
     41    CALL filtreg (divgra, jjp1, klevel, 2, 1, .TRUE., 1)
    4242
    43   CALL    grad (klevel,divgra, ghx  , ghy          )
    44   CALL  diverg (klevel,  ghx , ghy  , divgra       )
     43    CALL    grad (klevel, divgra, ghx, ghy)
     44    CALL  diverg (klevel, ghx, ghy, divgra)
    4545
    46   CALL filtreg ( divgra,jjp1,klevel,2,1,.TRUE.,1)
     46    CALL filtreg (divgra, jjp1, klevel, 2, 1, .TRUE., 1)
    4747
    48   DO l = 1,klevel
    49   DO ij = 1, ip1jmp1
    50   divgra( ij,l ) = - cdivh * divgra( ij,l )
    51   END DO
    52   END DO
    53   !
     48    DO l = 1, klevel
     49      DO ij = 1, ip1jmp1
     50        divgra(ij, l) = - cdivh * divgra(ij, l)
     51      END DO
     52    END DO
     53    !
    5454  END DO
    5555  RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/divgrad2.f90

    r5106 r5119  
    1 
    21! $Header$
    32
    4 SUBROUTINE divgrad2( klevel, h, deltapres, lh, divgra )
     3SUBROUTINE divgrad2(klevel, h, deltapres, lh, divgra)
    54  !
    65  ! P. Le Van
    … …  
    1312  !     divgra     est  un argument  de sortie pour le s-prg
    1413  !
     14  USE lmdz_ssum_scopy, ONLY: scopy
     15
    1516  IMPLICIT NONE
    1617  !
    … …  
    2324  !
    2425  INTEGER :: klevel
    25   REAL :: h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )
    26   REAL :: divgra( ip1jmp1,klevel)
     26  REAL :: h(ip1jmp1, klevel), deltapres(ip1jmp1, klevel)
     27  REAL :: divgra(ip1jmp1, klevel)
    2728  !
    2829  !    .......    variables  locales    ..........
    2930  !
    30   REAL :: signe, nudivgrs, sqrtps( ip1jmp1,llm )
    31   INTEGER :: l,ij,iter,lh
     31  REAL :: signe, nudivgrs, sqrtps(ip1jmp1, llm)
     32  INTEGER :: l, ij, iter, lh
    3233  !    ...................................................................
    3334
    3435  !
    35   signe    = (-1.)**lh
     36  signe = (-1.)**lh
    3637  nudivgrs = signe * cdivh
    3738
    38   CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
     39  CALL SCOPY (ip1jmp1 * klevel, h, 1, divgra, 1)
    3940
    4041  !
    41   CALL laplacien( klevel, divgra, divgra )
     42  CALL laplacien(klevel, divgra, divgra)
    4243
    4344  DO l = 1, klevel
    44    DO ij = 1, ip1jmp1
    45     sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
    46    ENDDO
     45    DO ij = 1, ip1jmp1
     46      sqrtps(ij, l) = SQRT(deltapres(ij, l))
     47    ENDDO
    4748  ENDDO
    4849  !
    4950  DO l = 1, klevel
    5051    DO ij = 1, ip1jmp1
    51      divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
     52      divgra(ij, l) = divgra(ij, l) * sqrtps(ij, l)
    5253    ENDDO
    5354  ENDDO
    … …  
    5657  !
    5758  DO  iter = 1, lh - 2
    58    CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2, &
    59          unsapolnga2, unsapolsga2,  divgra, divgra )
     59    CALL laplacien_gam (klevel, cuvscvgam2, cvuscugam2, unsair_gam2, &
     60            unsapolnga2, unsapolsga2, divgra, divgra)
    6061  ENDDO
    6162  !
    … …  
    6465  DO l = 1, klevel
    6566    DO ij = 1, ip1jmp1
    66       divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
     67      divgra(ij, l) = divgra(ij, l) * sqrtps(ij, l)
    6768    ENDDO
    6869  ENDDO
    6970  !
    70   CALL laplacien ( klevel, divgra, divgra )
     71  CALL laplacien (klevel, divgra, divgra)
    7172  !
    72   DO l  = 1,klevel
    73   DO ij = 1,ip1jmp1
    74   divgra(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
    75   ENDDO
     73  DO l = 1, klevel
     74    DO ij = 1, ip1jmp1
     75      divgra(ij, l) = nudivgrs * divgra(ij, l) / deltapres(ij, l)
     76    ENDDO
    7677  ENDDO
    7778

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_hyb_m.F90

    r5117 r5119  
    33  IMPLICIT NONE
    44
    5 contains
     5CONTAINS
    66
    77  SUBROUTINE exner_hyb( ngrid, ps, p, pks, pk, pkf )
    … …  
    145145  END SUBROUTINE exner_hyb
    146146
    147 end module exner_hyb_m
     147END MODULE exner_hyb_m

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/exner_milieu_m.F90

    r5117 r5119  
    33  IMPLICIT NONE
    44
    5 contains
     5CONTAINS
    66
    77  SUBROUTINE exner_milieu( ngrid, ps, p, pks, pk, pkf )
    … …  
    124124  END SUBROUTINE exner_milieu
    125125
    126 end module exner_milieu_m
     126END MODULE exner_milieu_m

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fxhyp_m.F90

    r5117 r5119  
    33  IMPLICIT NONE
    44
    5 contains
     5CONTAINS
    66
    77  SUBROUTINE fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)
    … …  
    246246  END SUBROUTINE fxhyp
    247247
    248 end module fxhyp_m
     248END MODULE fxhyp_m

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fyhyp_m.F90

    r5117 r5119  
    33  IMPLICIT NONE
    44
    5 contains
     5CONTAINS
    66
    77  SUBROUTINE fyhyp(rlatu, yyprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
    … …  
    338338  END SUBROUTINE fyhyp
    339339
    340 end module fyhyp_m
     340END MODULE fyhyp_m

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gr_u_scal.f90

    r5105 r5119  
    1 
    21! $Header$
    32
    4 SUBROUTINE gr_u_scal(nx,x_u,x_scal)
     3SUBROUTINE gr_u_scal(nx, x_u, x_scal)
    54  !%W%    %G%
    65  !=======================================================================
    … …  
    2524  !
    2625  !=======================================================================
     26  USE lmdz_ssum_scopy, ONLY: scopy
     27
    2728  IMPLICIT NONE
    2829  !-----------------------------------------------------------------------
    … …  
    3839
    3940  INTEGER :: nx
    40   REAL :: x_u(ip1jmp1,nx),x_scal(ip1jmp1,nx)
     41  REAL :: x_u(ip1jmp1, nx), x_scal(ip1jmp1, nx)
    4142
    4243  !   Local:
    4344  !   ------
    4445
    45   INTEGER :: l,ij
     46  INTEGER :: l, ij
    4647
    4748  !-----------------------------------------------------------------------
    4849
    49   DO l=1,nx
    50      DO ij=ip1jmp1,2,-1
    51         x_scal(ij,l)= &
    52               (aireu(ij)*x_u(ij,l)+aireu(ij-1)*x_u(ij-1,l)) &
    53               /(aireu(ij)+aireu(ij-1))
    54      ENDDO
     50  DO l = 1, nx
     51    DO ij = ip1jmp1, 2, -1
     52      x_scal(ij, l) = &
     53              (aireu(ij) * x_u(ij, l) + aireu(ij - 1) * x_u(ij - 1, l)) &
     54                      / (aireu(ij) + aireu(ij - 1))
     55    ENDDO
    5556  ENDDO
    5657
    57   CALL SCOPY(nx*jjp1,x_scal(iip1,1),iip1,x_scal(1,1),iip1)
     58  CALL SCOPY(nx * jjp1, x_scal(iip1, 1), iip1, x_scal(1, 1), iip1)
    5859
    5960  RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradiv.f90

    r5106 r5119  
    1 
    21! $Header$
    32
    4 SUBROUTINE gradiv(klevel, xcov, ycov, ld, gdx, gdy )
     3SUBROUTINE gradiv(klevel, xcov, ycov, ld, gdx, gdy)
    54  !
    65  !    Auteur :   P. Le Van
    … …  
    1817  !
    1918  USE lmdz_filtreg, ONLY: filtreg
     19  USE lmdz_ssum_scopy, ONLY: scopy
     20
    2021  IMPLICIT NONE
    2122  !
    … …  
    2627  INTEGER :: klevel
    2728  !
    28   REAL :: xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
    29   REAL :: gdx( ip1jmp1,klevel ),   gdy( ip1jm,klevel )
     29  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
     30  REAL :: gdx(ip1jmp1, klevel), gdy(ip1jm, klevel)
    3031
    31   REAL :: div(ip1jmp1,llm)
     32  REAL :: div(ip1jmp1, llm)
    3233
    33   INTEGER :: l,ij,iter,ld
     34  INTEGER :: l, ij, iter, ld
    3435  !
    3536  !
    3637  !
    37   CALL SCOPY( ip1jmp1*klevel,xcov,1,gdx,1 )
    38   CALL SCOPY( ip1jm*klevel,  ycov,1,gdy,1 )
     38  CALL SCOPY(ip1jmp1 * klevel, xcov, 1, gdx, 1)
     39  CALL SCOPY(ip1jm * klevel, ycov, 1, gdy, 1)
    3940  !
    40   DO iter = 1,ld
    41   !
    42   CALL  diverg( klevel,  gdx , gdy, div          )
    43   CALL filtreg( div, jjp1, klevel, 2,1, .TRUE.,2 )
    44   CALL    grad( klevel,  div, gdx, gdy           )
    45   !
    46   DO l = 1, klevel
    47   DO ij = 1, ip1jmp1
    48   gdx( ij,l ) = - gdx( ij,l ) * cdivu
    49   END DO
    50   DO ij = 1, ip1jm
    51   gdy( ij,l ) = - gdy( ij,l ) * cdivu
    52   END DO
    53   END DO
    54   !
     41  DO iter = 1, ld
     42    !
     43    CALL  diverg(klevel, gdx, gdy, div)
     44    CALL filtreg(div, jjp1, klevel, 2, 1, .TRUE., 2)
     45    CALL    grad(klevel, div, gdx, gdy)
     46    !
     47    DO l = 1, klevel
     48      DO ij = 1, ip1jmp1
     49        gdx(ij, l) = - gdx(ij, l) * cdivu
     50      END DO
     51      DO ij = 1, ip1jm
     52        gdy(ij, l) = - gdy(ij, l) * cdivu
     53      END DO
     54    END DO
     55    !
    5556  END DO
    5657  RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradiv2.f90

    r5106 r5119  
    1 
    21! $Header$
    32
    4 SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy )
     3SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy)
    54  !
    65  ! P. Le Van
    … …  
    1716  !
    1817  USE lmdz_filtreg, ONLY: filtreg
     18  USE lmdz_ssum_scopy, ONLY: scopy
     19
    1920  IMPLICIT NONE
    2021  !
    … …  
    2728
    2829  INTEGER :: klevel
    29   REAL :: xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
    30   REAL :: gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
     30  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
     31  REAL :: gdx(ip1jmp1, klevel), gdy(ip1jm, klevel)
    3132  !
    3233  ! ........       variables locales       .........
    3334  !
    34   REAL :: div(ip1jmp1,llm)
     35  REAL :: div(ip1jmp1, llm)
    3536  REAL :: signe, nugrads
    36   INTEGER :: l,ij,iter,ld
     37  INTEGER :: l, ij, iter, ld
    3738
    3839  !    ........................................................
    3940  !
    4041  !
    41   CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
    42   CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
     42  CALL SCOPY(ip1jmp1 * klevel, xcov, 1, gdx, 1)
     43  CALL SCOPY(ip1jm * klevel, ycov, 1, gdy, 1)
    4344  !
    4445  !
    45   signe   = (-1.)**ld
     46  signe = (-1.)**ld
    4647  nugrads = signe * cdivu
    4748  !
    4849
     50  CALL    divergf(klevel, gdx, gdy, div)
    4951
    50   CALL    divergf( klevel, gdx,   gdy , div )
     52  IF(ld>1)   THEN
    5153
    52   IF( ld>1 )   THEN
     54    CALL laplacien (klevel, div, div)
    5355
    54     CALL laplacien ( klevel, div,  div     )
     56    !    ......  Iteration de l'operateur laplacien_gam   .......
    5557
    56   !    ......  Iteration de l'operateur laplacien_gam   .......
    57 
    58     DO iter = 1, ld -2
    59      CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1, &
    60            unsapolnga1, unsapolsga1,  div, div       )
     58    DO iter = 1, ld - 2
     59      CALL laplacien_gam (klevel, cuvscvgam1, cvuscugam1, unsair_gam1, &
     60              unsapolnga1, unsapolsga1, div, div)
    6161    ENDDO
    6262
    6363  ENDIF
    6464
    65 
    66    CALL filtreg( div   , jjp1, klevel, 2, 1, .TRUE., 1 )
    67    CALL  grad  ( klevel,  div,   gdx,  gdy             )
     65  CALL filtreg(div, jjp1, klevel, 2, 1, .TRUE., 1)
     66  CALL  grad  (klevel, div, gdx, gdy)
    6867
    6968  !
    70    DO   l = 1, klevel
    71      DO  ij = 1, ip1jmp1
    72       gdx( ij,l ) = gdx( ij,l ) * nugrads
    73      ENDDO
    74      DO  ij = 1, ip1jm
    75       gdy( ij,l ) = gdy( ij,l ) * nugrads
    76      ENDDO
    77    ENDDO
     69  DO   l = 1, klevel
     70    DO  ij = 1, ip1jmp1
     71      gdx(ij, l) = gdx(ij, l) * nugrads
     72    ENDDO
     73    DO  ij = 1, ip1jm
     74      gdy(ij, l) = gdy(ij, l) * nugrads
     75    ENDDO
     76  ENDDO
    7877  !
    79    RETURN
     78  RETURN
    8079END SUBROUTINE gradiv2

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inter_barxy_m.F90

    r5117 r5119  
    1010  public inter_barxy
    1111
    12 contains
     12CONTAINS
    1313
    1414  SUBROUTINE inter_barxy(dlonid, dlatid, champ, rlonimod, rlatimod, champint)
    … …  
    448448  END function ord_coordm
    449449
    450 end module inter_barxy_m
     450END MODULE inter_barxy_m

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/invert_zoom_x_m.F90

    r5117 r5119  
    55  INTEGER, PARAMETER:: nmax = 30000
    66
    7 contains
     7CONTAINS
    88
    99  SUBROUTINE invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv)
    … …  
    8686  END SUBROUTINE  invert_zoom_x
    8787
    88 end module invert_zoom_x_m
     88END MODULE invert_zoom_x_m

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/laplacien.f90

    r5106 r5119  
    1 
    21! $Header$
    32
    4 SUBROUTINE laplacien( klevel, teta, divgra )
     3SUBROUTINE laplacien(klevel, teta, divgra)
    54  !
    65  ! P. Le Van
    … …  
    1312  !
    1413  USE lmdz_filtreg, ONLY: filtreg
     14  USE lmdz_ssum_scopy, ONLY: scopy
     15
    1516  IMPLICIT NONE
    1617  !
    … …  
    2324  !
    2425  INTEGER :: klevel
    25   REAL :: teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
     26  REAL :: teta(ip1jmp1, klevel), divgra(ip1jmp1, klevel)
    2627  !
    2728  !    ............     variables  locales      ..............
    2829  !
    29   REAL :: ghy(ip1jm,llm), ghx(ip1jmp1,llm)
     30  REAL :: ghy(ip1jm, llm), ghx(ip1jmp1, llm)
    3031  !    .......................................................
    3132
    3233
    3334  !
    34   CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
     35  CALL SCOPY (ip1jmp1 * klevel, teta, 1, divgra, 1)
    3536
    36   CALL filtreg( divgra,  jjp1, klevel,  2, 1, .TRUE., 1 )
    37   CALL   grad ( klevel,divgra,   ghx , ghy              )
    38   CALL  divergf ( klevel, ghx , ghy  , divgra           )
     37  CALL filtreg(divgra, jjp1, klevel, 2, 1, .TRUE., 1)
     38  CALL   grad (klevel, divgra, ghx, ghy)
     39  CALL  divergf (klevel, ghx, ghy, divgra)
    3940
    4041  RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/laplacien_gam.f90

    r5106 r5119  
    1 
    21! $Header$
    32
    4 SUBROUTINE laplacien_gam( klevel, cuvsga, cvusga, unsaigam , &
    5         unsapolnga, unsapolsga, teta, divgra )
     3SUBROUTINE laplacien_gam(klevel, cuvsga, cvusga, unsaigam, &
     4        unsapolnga, unsapolsga, teta, divgra)
    65
    76  !  P. Le Van
    … …  
    1413  !  divgra     est  un argument  de sortie pour le s-prog
    1514  !
     15  USE lmdz_ssum_scopy, ONLY: scopy
     16
    1617  IMPLICIT NONE
    1718  !
    … …  
    2425  !
    2526  INTEGER :: klevel
    26   REAL :: teta( ip1jmp1,klevel ), divgra( ip1jmp1,klevel )
    27   REAL :: cuvsga(ip1jm) , cvusga( ip1jmp1 ),unsaigam(ip1jmp1), &
    28         unsapolnga, unsapolsga
     27  REAL :: teta(ip1jmp1, klevel), divgra(ip1jmp1, klevel)
     28  REAL :: cuvsga(ip1jm), cvusga(ip1jmp1), unsaigam(ip1jmp1), &
     29          unsapolnga, unsapolsga
    2930  !
    3031  !    ...........    variables  locales    .................
    3132  !
    32   REAL :: ghy(ip1jm,llm), ghx(ip1jmp1,llm)
     33  REAL :: ghy(ip1jm, llm), ghx(ip1jmp1, llm)
    3334  !    ......................................................
    3435
    … …  
    4041  !
    4142
    42   CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
     43  CALL SCOPY (ip1jmp1 * klevel, teta, 1, divgra, 1)
    4344  !
    44   CALL   grad ( klevel, divgra, ghx, ghy )
     45  CALL   grad (klevel, divgra, ghx, ghy)
    4546  !
    46   CALL  diverg_gam ( klevel, cuvsga, cvusga,  unsaigam  , &
    47         unsapolnga, unsapolsga, ghx , ghy , divgra )
     47  CALL  diverg_gam (klevel, cuvsga, cvusga, unsaigam, &
     48          unsapolnga, unsapolsga, ghx, ghy, divgra)
    4849
    4950  !
    5051
    51 
    5252  RETURN
    5353END SUBROUTINE laplacien_gam

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/misc_mod.F90

    r5117 r5119  
    44  INTEGER,save :: ItCount
    55  logical,save :: debug
    6 end module misc_mod
     6END MODULE misc_mod

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/nxgraro2.f90

    r5106 r5119  
    1 
    21! $Header$
    32
    4  SUBROUTINE nxgraro2(klevel,xcov, ycov, lr, grx, gry )
     3SUBROUTINE nxgraro2(klevel, xcov, ycov, lr, grx, gry)
    54  !
    65  !  P.Le Van .
    … …  
    1615  !
    1716  USE lmdz_filtreg, ONLY: filtreg
     17  USE lmdz_ssum_scopy, ONLY: scopy
     18
    1819  IMPLICIT NONE
    1920  !
    … …  
    2526  !
    2627  INTEGER :: klevel
    27   REAL :: xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
    28   REAL :: grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
     28  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
     29  REAL :: grx(ip1jmp1, klevel), gry(ip1jm, klevel)
    2930  !
    3031  !    ......   variables locales     ........
    3132  !
    32   REAL :: rot(ip1jm,llm) , signe, nugradrs
    33   INTEGER :: l,ij,iter,lr
     33  REAL :: rot(ip1jm, llm), signe, nugradrs
     34  INTEGER :: l, ij, iter, lr
    3435  !    ........................................................
    3536  !
    3637  !
    3738  !
    38   signe    = (-1.)**lr
     39  signe = (-1.)**lr
    3940  nugradrs = signe * crot
    4041  !
    41   CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
    42   CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
     42  CALL SCOPY (ip1jmp1 * klevel, xcov, 1, grx, 1)
     43  CALL SCOPY (ip1jm * klevel, ycov, 1, gry, 1)
    4344  !
    44   CALL     rotatf     ( klevel, grx, gry, rot )
     45  CALL     rotatf     (klevel, grx, gry, rot)
    4546  !
    46   CALL laplacien_rot ( klevel, rot, rot,grx,gry      )
     47  CALL laplacien_rot (klevel, rot, rot, grx, gry)
    4748
    4849  !
    4950  !    .....   Iteration de l'operateur laplacien_rotgam  .....
    5051  !
    51   DO  iter = 1, lr -2
    52     CALL laplacien_rotgam ( klevel, rot, rot )
     52  DO  iter = 1, lr - 2
     53    CALL laplacien_rotgam (klevel, rot, rot)
    5354  ENDDO
    5455  !
    5556  !
    56   CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,1)
    57   CALL nxgrad ( klevel, rot, grx, gry )
     57  CALL filtreg(rot, jjm, klevel, 2, 1, .FALSE., 1)
     58  CALL nxgrad (klevel, rot, grx, gry)
    5859  !
    5960  DO    l = 1, klevel
    60      DO  ij = 1, ip1jm
    61       gry( ij,l ) = gry( ij,l ) * nugradrs
    62      ENDDO
    63      DO  ij = 1, ip1jmp1
    64       grx( ij,l ) = grx( ij,l ) * nugradrs
    65      ENDDO
     61    DO  ij = 1, ip1jm
     62      gry(ij, l) = gry(ij, l) * nugradrs
     63    ENDDO
     64    DO  ij = 1, ip1jmp1
     65      grx(ij, l) = grx(ij, l) * nugradrs
     66    ENDDO
    6667  ENDDO
    6768  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/nxgrarot.f90

    r5106 r5119  
    1 
    21! $Header$
    32
    4 SUBROUTINE nxgrarot(klevel,xcov, ycov, lr, grx, gry )
     3SUBROUTINE nxgrarot(klevel, xcov, ycov, lr, grx, gry)
    54  !   ***********************************************************
    65  !
    … …  
    1716  !
    1817  USE lmdz_filtreg, ONLY: filtreg
     18  USE lmdz_ssum_scopy, ONLY: scopy
     19
    1920  IMPLICIT NONE
    2021  !
    … …  
    2526  !
    2627  INTEGER :: klevel
    27   REAL :: xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
    28   REAL :: grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
     28  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
     29  REAL :: grx(ip1jmp1, klevel), gry(ip1jm, klevel)
    2930  !
    30   REAL :: rot(ip1jm,llm)
     31  REAL :: rot(ip1jm, llm)
    3132
    32   INTEGER :: l,ij,iter,lr
     33  INTEGER :: l, ij, iter, lr
    3334  !
    3435  !
    3536  !
    36   CALL SCOPY ( ip1jmp1*klevel, xcov, 1, grx, 1 )
    37   CALL SCOPY (  ip1jm*klevel, ycov, 1, gry, 1 )
     37  CALL SCOPY (ip1jmp1 * klevel, xcov, 1, grx, 1)
     38  CALL SCOPY (ip1jm * klevel, ycov, 1, gry, 1)
    3839  !
    39   DO iter = 1,lr
    40   CALL  rotat (klevel,grx, gry, rot )
    41   CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,2)
    42   CALL nxgrad (klevel,rot, grx, gry )
    43   !
    44   DO l = 1, klevel
    45   DO ij = 1, ip1jm
    46   gry( ij,l ) = - gry( ij,l ) * crot
    47   END DO
    48   DO ij = 1, ip1jmp1
    49   grx( ij,l ) = - grx( ij,l ) * crot
    50   END DO
    51   END DO
    52   !
     40  DO iter = 1, lr
     41    CALL  rotat (klevel, grx, gry, rot)
     42    CALL filtreg(rot, jjm, klevel, 2, 1, .FALSE., 2)
     43    CALL nxgrad (klevel, rot, grx, gry)
     44    !
     45    DO l = 1, klevel
     46      DO ij = 1, ip1jm
     47        gry(ij, l) = - gry(ij, l) * crot
     48      END DO
     49      DO ij = 1, ip1jmp1
     50        grx(ij, l) = - grx(ij, l) * crot
     51      END DO
     52    END DO
     53    !
    5354  END DO
    5455  RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/principal_cshift_m.F90

    r5117 r5119  
    33  IMPLICIT NONE
    44
    5 contains
     5CONTAINS
    66
    77  SUBROUTINE principal_cshift(is2, xlon, xprimm)
    … …  
    4141  END SUBROUTINE  principal_cshift
    4242
    43 end module principal_cshift_m
     43END MODULE principal_cshift_m

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/sortvarc.f90

    r5118 r5119  
    1313  USE lmdz_filtreg, ONLY: filtreg
    1414  USE lmdz_iniprint, ONLY: lunout, prt_level
     15  USE lmdz_ssum_scopy, ONLY: scopy
     16
    1517  IMPLICIT NONE
    1618
Note: See TracChangeset for help on using the changeset viewer.