Changeset 5246 for LMDZ6/trunk/libf/dyn3d_common/divergf.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d_common/divergf.f90
r5245 r5246 2 2 ! $Header$ 3 3 ! 4 5 c 6 cP. Le Van7 c 8 c*********************************************************************9 c ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 10 cx et y...11 cx et y etant des composantes covariantes ...12 c*********************************************************************13 14 c 15 cx et y sont des arguments d'entree pour le s-prog16 cdiv est un argument de sortie pour le s-prog17 c 18 c 19 c---------------------------------------------------------------------20 c 21 cATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/ .22 c 23 c---------------------------------------------------------------------24 25 26 27 c 28 c.......... variables en arguments ...................29 c 30 INTEGERklevel31 REALx( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )32 INTEGERl,ij33 c 34 c............... variables locales .........................4 SUBROUTINE divergf(klevel,x,y,div) 5 ! 6 ! P. Le Van 7 ! 8 ! ********************************************************************* 9 ! ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 10 ! x et y... 11 ! x et y etant des composantes covariantes ... 12 ! ********************************************************************* 13 IMPLICIT NONE 14 ! 15 ! x et y sont des arguments d'entree pour le s-prog 16 ! div est un argument de sortie pour le s-prog 17 ! 18 ! 19 ! --------------------------------------------------------------------- 20 ! 21 ! ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/ . 22 ! 23 ! --------------------------------------------------------------------- 24 INCLUDE "dimensions.h" 25 INCLUDE "paramet.h" 26 INCLUDE "comgeom.h" 27 ! 28 ! .......... variables en arguments ................... 29 ! 30 INTEGER :: klevel 31 REAL :: x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel ) 32 INTEGER :: l,ij 33 ! 34 ! ............... variables locales ......................... 35 35 36 REALaiy1( iip1 ) , aiy2( iip1 )37 REALsumypn,sumyps38 c...................................................................39 c 40 REALSSUM41 c 42 c 43 DO 10l = 1,klevel44 c 45 46 div( ij + 1, l ) =47 * cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +48 * cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)49 50 c 51 c.... correction pour div( 1,j,l) ......52 c.... div(1,j,l)= div(iip1,j,l) ....53 c 54 CDIR$ IVDEP55 56 57 58 c 59 c.... calcul aux poles .....60 c 61 62 63 64 65 66 67 c 68 69 70 71 72 10 CONTINUE73 c 36 REAL :: aiy1( iip1 ) , aiy2( iip1 ) 37 REAL :: sumypn,sumyps 38 ! ................................................................... 39 ! 40 REAL :: SSUM 41 ! 42 ! 43 DO l = 1,klevel 44 ! 45 DO ij = iip2, ip1jm - 1 46 div( ij + 1, l ) = & 47 cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) + & 48 cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l) 49 ENDDO 50 ! 51 ! .... correction pour div( 1,j,l) ...... 52 ! .... div(1,j,l)= div(iip1,j,l) .... 53 ! 54 !DIR$ IVDEP 55 DO ij = iip2,ip1jm,iip1 56 div( ij,l ) = div( ij + iim,l ) 57 ENDDO 58 ! 59 ! .... calcul aux poles ..... 60 ! 61 DO ij = 1,iim 62 aiy1(ij) = cuvsurcv( ij ) * y( ij , l ) 63 aiy2(ij) = cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l ) 64 ENDDO 65 sumypn = SSUM ( iim,aiy1,1 ) / apoln 66 sumyps = SSUM ( iim,aiy2,1 ) / apols 67 ! 68 DO ij = 1,iip1 69 div( ij , l ) = - sumypn 70 div( ij + ip1jm, l ) = sumyps 71 ENDDO 72 END DO 73 ! 74 74 75 76 77 c 78 79 80 div(ij,l) = div(ij,l) * unsaire(ij)81 82 83 c 84 85 END 75 CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 ) 76 77 ! 78 DO l = 1, klevel 79 DO ij = iip2,ip1jm 80 div(ij,l) = div(ij,l) * unsaire(ij) 81 ENDDO 82 ENDDO 83 ! 84 RETURN 85 END SUBROUTINE divergf
Note: See TracChangeset
for help on using the changeset viewer.