Changeset 2336 for LMDZ5/trunk/libf/dyn3dmem/massbar_loc.F90
- Timestamp:
- Jul 31, 2015, 7:22:21 PM (10 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/dyn3dmem/massbar_loc.F90
r2335 r2336 1 SUBROUTINE massbar_loc( masse, massebx, masseby ) 2 3 c 4 c ********************************************************************** 5 c 6 c Calcule les moyennes en x et y de la masse d'air dans chaque maille. 7 c ********************************************************************** 8 c Auteurs : P. Le Van , Fr. Hourdin . 9 c .......... 10 c 11 c .. masse est un argum. d'entree pour le s-pg ... 12 c .. massebx,masseby sont des argum. de sortie pour le s-pg ... 13 c 14 c 15 USE parallel_lmdz 16 IMPLICIT NONE 17 c 18 #include "dimensions.h" 19 #include "paramet.h" 20 #include "comconst.h" 21 #include "comgeom.h" 22 c 23 REAL masse( ijb_u:ije_u,llm ), massebx( ijb_u:ije_u,llm ) , 24 * masseby( ijb_v:ije_v,llm ) 25 INTEGER ij,l,ijb,ije 26 c 27 c 28 c Methode pour calculer massebx et masseby . 29 c ---------------------------------------- 30 c 31 c A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires 32 c alpha1(i,j) calcule au point ( i+1/4,j-1/4 ) 33 c alpha2(i,j) calcule au point ( i+1/4,j+1/4 ) 34 c alpha3(i,j) calcule au point ( i-1/4,j+1/4 ) 35 c alpha4(i,j) calcule au point ( i-1/4,j-1/4 ) 36 c 37 c Avec alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j) 38 c 39 c N.B . Pour plus de details, voir s-pg ... iniconst ... 40 c 41 c 42 c 43 c alpha4 . . alpha1 . alpha4 44 c (i,j) (i,j) (i+1,j) 45 c 46 c P . U . . P 47 c (i,j) (i,j) (i+1,j) 48 c 49 c alpha3 . . alpha2 .alpha3 50 c (i,j) (i,j) (i+1,j) 51 c 52 c V . Z . . V 53 c (i,j) 54 c 55 c alpha4 . . alpha1 .alpha4 56 c (i,j+1) (i,j+1) (i+1,j+1) 57 c 58 c P . U . . P 59 c (i,j+1) (i+1,j+1) 60 c 61 c 62 c 63 c On a : 64 c 65 c massebx(i,j) = masse(i ,j) * ( alpha1(i ,j) + alpha2(i,j)) + 66 c masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) ) 67 c localise au point ... U (i,j) ... 68 c 69 c masseby(i,j) = masse(i,j ) * ( alpha2(i,j ) + alpha3(i,j ) + 70 c masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 71 c localise au point ... V (i,j) ... 72 c 73 c 74 c======================================================================= 75 76 77 78 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 79 DO 100 l = 1 , llm 80 c 81 ijb=ij_begin 82 ije=ij_end+iip1 83 if (pole_sud) ije=ije-iip1 84 85 DO ij = ijb, ije - 1 86 massebx(ij,l) = masse( ij, l) * alpha1p2( ij ) + 87 * masse(ij+1, l) * alpha3p4(ij+1 ) 88 ENDDO 1 SUBROUTINE massbar_loc(masse,massebx,masseby) 2 ! 3 !------------------------------------------------------------------------------- 4 ! Authors: P. Le Van , Fr. Hourdin. 5 !------------------------------------------------------------------------------- 6 ! Purpose: Compute air mass mean along X and Y in each cell. 7 ! See iniconst for more details. 8 USE parallel_lmdz 9 IMPLICIT NONE 10 include "dimensions.h" 11 include "paramet.h" 12 include "comgeom.h" 13 !=============================================================================== 14 ! Arguments: 15 REAL, INTENT(IN) :: masse (ijb_u:ije_u,llm) 16 REAL, INTENT(OUT) :: massebx(ijb_u:ije_u,llm) 17 REAL, INTENT(OUT) :: masseby(ijb_v:ije_v,llm) 18 !------------------------------------------------------------------------------- 19 ! Method used. Each scalar point is associated to 4 area coefficients: 20 ! * alpha1(i,j) at point ( i+1/4,j-1/4 ) 21 ! * alpha2(i,j) at point ( i+1/4,j+1/4 ) 22 ! * alpha3(i,j) at point ( i-1/4,j+1/4 ) 23 ! * alpha4(i,j) at point ( i-1/4,j-1/4 ) 24 ! where alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j) 25 ! 26 ! alpha4 . . alpha1 . alpha4 27 ! (i,j) (i,j) (i+1,j) 28 ! 29 ! P . U . . P 30 ! (i,j) (i,j) (i+1,j) 31 ! 32 ! alpha3 . . alpha2 .alpha3 33 ! (i,j) (i,j) (i+1,j) 34 ! 35 ! V . Z . . V 36 ! (i,j) 37 ! 38 ! alpha4 . . alpha1 .alpha4 39 ! (i,j+1) (i,j+1) (i+1,j+1) 40 ! 41 ! P . U . . P 42 ! (i,j+1) (i+1,j+1) 43 ! 44 ! 45 ! massebx(i,j) = masse(i ,j) * ( alpha1(i ,j) + alpha2(i,j)) + 46 ! masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) ) 47 ! localized at point ... U (i,j) ... 48 ! 49 ! masseby(i,j) = masse(i,j ) * ( alpha2(i,j ) + alpha3(i,j ) + 50 ! masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 51 ! localized at point ... V (i,j) ... 52 !=============================================================================== 53 ! Local variables: 54 INTEGER :: ij, l, ijb, ije 55 !=============================================================================== 56 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 57 DO l=1,llm 58 ijb=ij_begin 59 ije=ij_end+iip1 60 IF(pole_sud) ije=ije-iip1 61 DO ij=ijb,ije-1 62 massebx(ij,l)=masse(ij,l)*alpha1p2(ij)+masse(ij+1 ,l)*alpha3p4(ij+1) 63 END DO 64 DO ij=ijb+iim,ije+iim,iip1; massebx(ij,l)=massebx(ij-iim,l); END DO 65 ijb=ij_begin-iip1 66 ije=ij_end+iip1 67 IF(pole_nord) ijb=ij_begin 68 IF(pole_sud) ije=ij_end-iip1 69 DO ij=ijb,ije 70 masseby(ij,l)=masse(ij,l)*alpha2p3(ij)+masse(ij+iip1,l)*alpha1p4(ij+iip1) 71 END DO 72 END DO 73 !$OMP END DO NOWAIT 89 74 90 c .... correction pour massebx( iip1,j) ..... 91 c ... massebx(iip1,j)= massebx(1,j) ... 92 c 93 CDIR$ IVDEP 75 END SUBROUTINE massbar_loc 94 76 95 96 97 DO ij = ijb+iim, ije+iim, iip198 massebx( ij,l ) = massebx( ij - iim,l )99 ENDDO100 101 102 103 ijb=ij_begin-iip1104 ije=ij_end+iip1105 if (pole_nord) ijb=ij_begin106 if (pole_sud) ije=ij_end-iip1107 108 DO ij = ijb,ije109 masseby( ij,l ) = masse( ij , l ) * alpha2p3( ij ) +110 * masse(ij+iip1, l ) * alpha1p4( ij+iip1 )111 ENDDO112 113 100 CONTINUE114 c$OMP END DO NOWAIT115 c116 RETURN117 END
Note: See TracChangeset
for help on using the changeset viewer.