Changeset 5105 for LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90
- Timestamp:
- Jul 23, 2024, 7:14:34 PM (8 weeks ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90
r5104 r5105 1 2 c 3 cP. Le Van4 c 5 c*********************************************************************6 c ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 7 cx et y...8 cx et y etant des composantes covariantes ...9 c*********************************************************************10 11 12 13 c 14 cx et y sont des arguments d'entree pour le s-prog15 cdiv est un argument de sortie pour le s-prog16 c 17 c 18 c---------------------------------------------------------------------19 c 20 cATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/ .21 c 22 c---------------------------------------------------------------------23 24 25 26 c 27 c.......... variables en arguments ...................28 c 29 INTEGERklevel30 REALx( ijb_u:ije_u,klevel ),y( ijb_v:ije_v,klevel )31 REALdiv( ijb_u:ije_u,klevel )32 INTEGERl,ij33 c 34 c............... variables locales .........................1 SUBROUTINE divergf_loc(klevel,x,y,div) 2 ! 3 ! P. Le Van 4 ! 5 ! ********************************************************************* 6 ! ... calcule la divergence a tous les niveaux d'1 vecteur de compos. 7 ! x et y... 8 ! x et y etant des composantes covariantes ... 9 ! ********************************************************************* 10 USE parallel_lmdz 11 USE mod_filtreg_p 12 IMPLICIT NONE 13 ! 14 ! x et y sont des arguments d'entree pour le s-prog 15 ! div est un argument de sortie pour le s-prog 16 ! 17 ! 18 ! --------------------------------------------------------------------- 19 ! 20 ! ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/ . 21 ! 22 ! --------------------------------------------------------------------- 23 INCLUDE "dimensions.h" 24 INCLUDE "paramet.h" 25 INCLUDE "comgeom.h" 26 ! 27 ! .......... variables en arguments ................... 28 ! 29 INTEGER :: klevel 30 REAL :: x( ijb_u:ije_u,klevel ),y( ijb_v:ije_v,klevel ) 31 REAL :: div( ijb_u:ije_u,klevel ) 32 INTEGER :: l,ij 33 ! 34 ! ............... variables locales ......................... 35 35 36 REALaiy1( iip1 ) , aiy2( iip1 )37 REALsumypn,sumyps38 c...................................................................39 c 40 41 REALSSUM42 43 c 44 c 45 46 47 48 36 REAL :: aiy1( iip1 ) , aiy2( iip1 ) 37 REAL :: sumypn,sumyps 38 ! ................................................................... 39 ! 40 EXTERNAL SSUM 41 REAL :: SSUM 42 INTEGER :: ijb,ije,jjb,jje 43 ! 44 ! 45 ijb=ij_begin 46 ije=ij_end 47 if (pole_nord) ijb=ij_begin+iip1 48 if(pole_sud) ije=ij_end-iip1 49 49 50 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 51 52 c 53 54 div( ij + 1, l ) =55 * cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +56 * cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)57 50 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 51 DO l = 1,klevel 52 ! 53 DO ij = ijb, ije - 1 54 div( ij + 1, l ) = & 55 cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) + & 56 cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l) 57 ENDDO 58 58 59 c 60 c .... correction pour div( 1,j,l) ...... 61 c .... div(1,j,l)= div(iip1,j,l) .... 62 c 63 CDIR$ IVDEP 64 DO ij = ijb,ije,iip1 65 div( ij,l ) = div( ij + iim,l ) 66 ENDDO 67 c 68 c .... calcul aux poles ..... 69 c 70 if (pole_nord) then 71 72 DO ij = 1,iim 73 aiy1(ij) = cuvsurcv( ij ) * y( ij , l ) 74 ENDDO 75 sumypn = SSUM ( iim,aiy1,1 ) / apoln 59 ! 60 ! .... correction pour div( 1,j,l) ...... 61 ! .... div(1,j,l)= div(iip1,j,l) .... 62 ! 63 !DIR$ IVDEP 64 DO ij = ijb,ije,iip1 65 div( ij,l ) = div( ij + iim,l ) 66 ENDDO 67 ! 68 ! .... calcul aux poles ..... 69 ! 70 if (pole_nord) then 76 71 77 c 78 DO ij = 1,iip1 79 div( ij , l ) = - sumypn 80 ENDDO 81 82 endif 83 84 if (pole_sud) then 85 86 DO ij = 1,iim 87 aiy2(ij) = cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l ) 88 ENDDO 89 sumyps = SSUM ( iim,aiy2,1 ) / apols 90 c 91 DO ij = 1,iip1 92 div( ij + ip1jm, l ) = sumyps 93 ENDDO 94 95 endif 96 97 END DO 98 c$OMP END DO NOWAIT 72 DO ij = 1,iim 73 aiy1(ij) = cuvsurcv( ij ) * y( ij , l ) 74 ENDDO 75 sumypn = SSUM ( iim,aiy1,1 ) / apoln 99 76 100 c 101 jjb=jj_begin 102 jje=jj_end 103 if (pole_sud) jje=jj_end-1 104 105 CALL filtreg_p( div,jjb_u,jje_u,jjb,jje, jjp1, 106 & klevel, 2, 2, .TRUE., 1 ) 107 108 c 109 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 110 DO l = 1, klevel 111 DO ij = ijb,ije 112 div(ij,l) = div(ij,l) * unsaire(ij) 113 ENDDO 114 ENDDO 115 c$OMP END DO NOWAIT 116 c 117 RETURN 118 END 77 ! 78 DO ij = 1,iip1 79 div( ij , l ) = - sumypn 80 ENDDO 81 82 endif 83 84 if (pole_sud) then 85 86 DO ij = 1,iim 87 aiy2(ij) = cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l ) 88 ENDDO 89 sumyps = SSUM ( iim,aiy2,1 ) / apols 90 ! 91 DO ij = 1,iip1 92 div( ij + ip1jm, l ) = sumyps 93 ENDDO 94 95 endif 96 97 END DO 98 !$OMP END DO NOWAIT 99 100 ! 101 jjb=jj_begin 102 jje=jj_end 103 if (pole_sud) jje=jj_end-1 104 105 CALL filtreg_p( div,jjb_u,jje_u,jjb,jje, jjp1, & 106 klevel, 2, 2, .TRUE., 1 ) 107 108 ! 109 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 110 DO l = 1, klevel 111 DO ij = ijb,ije 112 div(ij,l) = div(ij,l) * unsaire(ij) 113 ENDDO 114 ENDDO 115 !$OMP END DO NOWAIT 116 ! 117 118 END SUBROUTINE divergf_loc
Note: See TracChangeset
for help on using the changeset viewer.
