Changeset 5246 for LMDZ6/trunk/libf/dyn3d_common/divgrad2.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (22 hours ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d_common/divgrad2.f90
r5245 r5246 2 2 ! $Header$ 3 3 ! 4 5 c 6 cP. Le Van7 c 8 c***************************************************************9 c 10 c..... calcul de (div( grad )) de ( pext * h ) .....11 c****************************************************************12 ch ,klevel,lh et pext sont des arguments d'entree pour le s-prg13 cdivgra est un argument de sortie pour le s-prg14 c 15 16 c 17 18 19 20 4 SUBROUTINE divgrad2 ( klevel, h, deltapres, lh, divgra ) 5 ! 6 ! P. Le Van 7 ! 8 ! *************************************************************** 9 ! 10 ! ..... calcul de (div( grad )) de ( pext * h ) ..... 11 ! **************************************************************** 12 ! h ,klevel,lh et pext sont des arguments d'entree pour le s-prg 13 ! divgra est un argument de sortie pour le s-prg 14 ! 15 IMPLICIT NONE 16 ! 17 INCLUDE "dimensions.h" 18 INCLUDE "paramet.h" 19 INCLUDE "comgeom2.h" 20 INCLUDE "comdissipn.h" 21 21 22 c....... variables en arguments .......23 c 24 INTEGERklevel25 REALh( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel )26 REALdivgra( ip1jmp1,klevel)27 c 28 c....... variables locales ..........29 c 30 REALsigne, nudivgrs, sqrtps( ip1jmp1,llm )31 INTEGERl,ij,iter,lh32 c...................................................................22 ! ....... variables en arguments ....... 23 ! 24 INTEGER :: klevel 25 REAL :: h( ip1jmp1,klevel ), deltapres( ip1jmp1,klevel ) 26 REAL :: divgra( ip1jmp1,klevel) 27 ! 28 ! ....... variables locales .......... 29 ! 30 REAL :: signe, nudivgrs, sqrtps( ip1jmp1,llm ) 31 INTEGER :: l,ij,iter,lh 32 ! ................................................................... 33 33 34 c 35 36 34 ! 35 signe = (-1.)**lh 36 nudivgrs = signe * cdivh 37 37 38 38 CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 ) 39 39 40 c 41 CALL laplacien( klevel, divgra, divgra ) 42 43 DO l = 1, klevel 44 DO ij = 1, ip1jmp1 45 sqrtps( ij,l ) = SQRT( deltapres(ij,l) ) 46 ENDDO 47 ENDDO 48 c 49 DO l = 1, klevel 50 DO ij = 1, ip1jmp1 51 divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l) 52 ENDDO 53 ENDDO 54 55 c ........ Iteration de l'operateur laplacien_gam ........ 56 c 57 DO iter = 1, lh - 2 58 CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2, 59 * unsapolnga2, unsapolsga2, divgra, divgra ) 60 ENDDO 61 c 62 c ............................................................... 63 64 DO l = 1, klevel 65 DO ij = 1, ip1jmp1 66 divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l) 67 ENDDO 68 ENDDO 69 c 70 CALL laplacien ( klevel, divgra, divgra ) 71 c 72 DO l = 1,klevel 73 DO ij = 1,ip1jmp1 74 divgra(ij,l) = nudivgrs * divgra(ij,l) / deltapres(ij,l) 75 ENDDO 76 ENDDO 40 ! 41 CALL laplacien( klevel, divgra, divgra ) 77 42 78 RETURN 79 END 43 DO l = 1, klevel 44 DO ij = 1, ip1jmp1 45 sqrtps( ij,l ) = SQRT( deltapres(ij,l) ) 46 ENDDO 47 ENDDO 48 ! 49 DO l = 1, klevel 50 DO ij = 1, ip1jmp1 51 divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l) 52 ENDDO 53 ENDDO 54 55 ! ........ Iteration de l'operateur laplacien_gam ........ 56 ! 57 DO iter = 1, lh - 2 58 CALL laplacien_gam ( klevel,cuvscvgam2,cvuscugam2,unsair_gam2, & 59 unsapolnga2, unsapolsga2, divgra, divgra ) 60 ENDDO 61 ! 62 ! ............................................................... 63 64 DO l = 1, klevel 65 DO ij = 1, ip1jmp1 66 divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l) 67 ENDDO 68 ENDDO 69 ! 70 CALL laplacien ( klevel, divgra, divgra ) 71 ! 72 DO l = 1,klevel 73 DO ij = 1,ip1jmp1 74 divgra(ij,l) = nudivgrs * divgra(ij,l) / deltapres(ij,l) 75 ENDDO 76 ENDDO 77 78 RETURN 79 END SUBROUTINE divgrad2
Note: See TracChangeset
for help on using the changeset viewer.