Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/massdair_loc.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (22 hours ago)
- File:
-
- 1 moved
-
LMDZ6/trunk/libf/dyn3dmem/massdair_loc.f90 (moved) (moved from LMDZ6/trunk/libf/dyn3dmem/massdair_loc.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/massdair_loc.f90
r5245 r5246 1 2 3 c 4 c*********************************************************************5 c.... Calcule la masse d'air dans chaque maille ....6 c*********************************************************************7 c 8 cAuteurs : P. Le Van , Fr. Hourdin .9 c..........10 c 11 c.. p est un argum. d'entree pour le s-pg ...12 c.. masse est un argum.de sortie pour le s-pg ...13 c 14 c.... p est defini aux interfaces des llm couches .....15 c 16 17 c 18 19 20 21 c 22 c..... arguments ....23 c 24 REALp(ijb_u:ije_u,llmp1), masse(ijb_u:ije_u,llm)1 SUBROUTINE massdair_loc( p, masse ) 2 USE parallel_lmdz 3 ! 4 ! ********************************************************************* 5 ! .... Calcule la masse d'air dans chaque maille .... 6 ! ********************************************************************* 7 ! 8 ! Auteurs : P. Le Van , Fr. Hourdin . 9 ! .......... 10 ! 11 ! .. p est un argum. d'entree pour le s-pg ... 12 ! .. masse est un argum.de sortie pour le s-pg ... 13 ! 14 ! .... p est defini aux interfaces des llm couches ..... 15 ! 16 IMPLICIT NONE 17 ! 18 include "dimensions.h" 19 include "paramet.h" 20 include "comgeom.h" 21 ! 22 ! ..... arguments .... 23 ! 24 REAL :: p(ijb_u:ije_u,llmp1), masse(ijb_u:ije_u,llm) 25 25 26 c.... Variables locales .....26 ! .... Variables locales ..... 27 27 28 INTEGERl,ij29 INTEGERijb,ije30 REALmassemoyn, massemoys28 INTEGER :: l,ij 29 INTEGER :: ijb,ije 30 REAL :: massemoyn, massemoys 31 31 32 REALSSUM33 34 c 35 c 36 cMethode pour calculer massebx et masseby .37 c----------------------------------------38 c 39 cA chaque point scalaire P (i,j) est affecte 4 coefficients d'aires40 calpha1(i,j) calcule au point ( i+1/4,j-1/4 )41 calpha2(i,j) calcule au point ( i+1/4,j+1/4 )42 calpha3(i,j) calcule au point ( i-1/4,j+1/4 )43 calpha4(i,j) calcule au point ( i-1/4,j-1/4 )44 c 45 c Avec alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j) 46 c 47 cN.B . Pour plus de details, voir s-pg ... iniconst ...48 c 49 c 50 c 51 calpha4 . . alpha1 . alpha452 c(i,j) (i,j) (i+1,j)53 c 54 cP . U . . P55 c(i,j) (i,j) (i+1,j)56 c 57 c alpha3 . . alpha2 .alpha3 58 c(i,j) (i,j) (i+1,j)59 c 60 cV . Z . . V61 c(i,j)62 c 63 calpha4 . . alpha1 .alpha464 c (i,j+1) (i,j+1) (i+1,j+1) 65 c 66 cP . U . . P67 c(i,j+1) (i+1,j+1)68 c 69 c 70 c 71 cOn a :72 c 73 cmassebx(i,j) = masse(i ,j) * ( alpha1(i ,j) + alpha2(i,j)) +74 cmasse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )75 clocalise au point ... U (i,j) ...76 c 77 cmasseby(i,j) = masse(i,j ) * ( alpha2(i,j ) + alpha3(i,j ) +78 c masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 79 clocalise au point ... V (i,j) ...80 c 81 c 82 c=======================================================================32 REAL :: SSUM 33 EXTERNAL SSUM 34 ! 35 ! 36 ! Methode pour calculer massebx et masseby . 37 ! ---------------------------------------- 38 ! 39 ! A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires 40 ! alpha1(i,j) calcule au point ( i+1/4,j-1/4 ) 41 ! alpha2(i,j) calcule au point ( i+1/4,j+1/4 ) 42 ! alpha3(i,j) calcule au point ( i-1/4,j+1/4 ) 43 ! alpha4(i,j) calcule au point ( i-1/4,j-1/4 ) 44 ! 45 ! Avec alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j) 46 ! 47 ! N.B . Pour plus de details, voir s-pg ... iniconst ... 48 ! 49 ! 50 ! 51 ! alpha4 . . alpha1 . alpha4 52 ! (i,j) (i,j) (i+1,j) 53 ! 54 ! P . U . . P 55 ! (i,j) (i,j) (i+1,j) 56 ! 57 ! alpha3 . . alpha2 .alpha3 58 ! (i,j) (i,j) (i+1,j) 59 ! 60 ! V . Z . . V 61 ! (i,j) 62 ! 63 ! alpha4 . . alpha1 .alpha4 64 ! (i,j+1) (i,j+1) (i+1,j+1) 65 ! 66 ! P . U . . P 67 ! (i,j+1) (i+1,j+1) 68 ! 69 ! 70 ! 71 ! On a : 72 ! 73 ! massebx(i,j) = masse(i ,j) * ( alpha1(i ,j) + alpha2(i,j)) + 74 ! masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) ) 75 ! localise au point ... U (i,j) ... 76 ! 77 ! masseby(i,j) = masse(i,j ) * ( alpha2(i,j ) + alpha3(i,j ) + 78 ! masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 79 ! localise au point ... V (i,j) ... 80 ! 81 ! 82 !======================================================================= 83 83 84 85 84 86 87 ijb=ij_begin-iip188 ije=ij_end+2*iip189 90 if (pole_nord) ijb=ij_begin91 if (pole_sud) ije=ij_end92 85 93 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 94 DO 100 l = 1 , llm 95 c 96 DO ij = ijb, ije 97 masse(ij,l) = airesurg(ij) * ( p(ij,l) - p(ij,l+1) ) 98 ENDDO 99 c 100 DO ij = ijb, ije,iip1 101 masse(ij+ iim,l) = masse(ij,l) 102 ENDDO 103 c 104 c DO ij = 1, iim 105 c masse( ij ,l) = masse( ij ,l) * aire( ij ) 106 c masse(ij+ip1jm,l) = masse(ij+ip1jm,l) * aire(ij+ip1jm) 107 c ENDDO 108 c massemoyn = SSUM(iim,masse( 1 ,l),1)/ apoln 109 c massemoys = SSUM(iim,masse(ip1jm+1,l),1)/ apols 110 c DO ij = 1, iip1 111 c masse( ij ,l ) = massemoyn 112 c masse(ij+ip1jm,l ) = massemoys 113 c ENDDO 114 115 100 CONTINUE 116 c$OMP END DO NOWAIT 117 c 118 RETURN 119 END 86 87 ijb=ij_begin-iip1 88 ije=ij_end+2*iip1 89 90 if (pole_nord) ijb=ij_begin 91 if (pole_sud) ije=ij_end 92 93 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 94 DO l = 1 , llm 95 ! 96 DO ij = ijb, ije 97 masse(ij,l) = airesurg(ij) * ( p(ij,l) - p(ij,l+1) ) 98 ENDDO 99 ! 100 DO ij = ijb, ije,iip1 101 masse(ij+ iim,l) = masse(ij,l) 102 ENDDO 103 ! 104 ! DO ij = 1, iim 105 ! masse( ij ,l) = masse( ij ,l) * aire( ij ) 106 ! masse(ij+ip1jm,l) = masse(ij+ip1jm,l) * aire(ij+ip1jm) 107 ! ENDDO 108 ! massemoyn = SSUM(iim,masse( 1 ,l),1)/ apoln 109 ! massemoys = SSUM(iim,masse(ip1jm+1,l),1)/ apols 110 ! DO ij = 1, iip1 111 ! masse( ij ,l ) = massemoyn 112 ! masse(ij+ip1jm,l ) = massemoys 113 ! ENDDO 114 115 END DO 116 !$OMP END DO NOWAIT 117 ! 118 RETURN 119 END SUBROUTINE massdair_loc
Note: See TracChangeset
for help on using the changeset viewer.
