Changeset 5186 for LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_advect.f90
- Timestamp:
- Sep 11, 2024, 6:03:07 PM (9 days ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_advect.f90
r5185 r5186 1 ! $Header$ 1 MODULE lmdz_advect 2 IMPLICIT NONE; PRIVATE 3 PUBLIC advect 2 4 3 SUBROUTINE advect(ucov, vcov, teta, w, massebx, masseby, du, dv, dteta) 5 CONTAINS 4 6 5 USE comconst_mod, ONLY: daysec 6 USE logic_mod, ONLY: conser 7 USE ener_mod, ONLY: gtot 8 USE lmdz_ssum_scopy, ONLY: ssum 9 USE lmdz_comgeom 7 SUBROUTINE advect(ucov, vcov, teta, w, massebx, masseby, du, dv, dteta) 10 8 11 USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm 12 USE lmdz_paramet 13 IMPLICIT NONE 14 !======================================================================= 9 USE comconst_mod, ONLY: daysec 10 USE logic_mod, ONLY: conser 11 USE ener_mod, ONLY: gtot 12 USE lmdz_ssum_scopy, ONLY: ssum 13 USE lmdz_comgeom 15 14 16 ! Auteurs: P. Le Van , Fr. Hourdin . 17 ! ------- 15 USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm 16 USE lmdz_paramet 17 IMPLICIT NONE 18 !======================================================================= 18 19 19 ! Objet:20 !------20 ! Auteurs: P. Le Van , Fr. Hourdin . 21 ! ------- 21 22 22 ! ************************************************************* 23 ! .... calcul des termes d'advection vertic.pour u,v,teta,q ... 24 ! ************************************************************* 25 ! ces termes sont ajoutes a du,dv,dteta et dq . 26 ! Modif F.Forget 03/94 : on retire q de advect 23 ! Objet: 24 ! ------ 27 25 28 !======================================================================= 29 !----------------------------------------------------------------------- 30 ! Declarations: 31 ! ------------- 26 ! ************************************************************* 27 ! .... calcul des termes d'advection vertic.pour u,v,teta,q ... 28 ! ************************************************************* 29 ! ces termes sont ajoutes a du,dv,dteta et dq . 30 ! Modif F.Forget 03/94 : on retire q de advect 31 32 !======================================================================= 33 !----------------------------------------------------------------------- 34 ! Declarations: 35 ! ------------- 32 36 33 37 34 38 35 39 36 ! Arguments:37 ! ----------40 ! Arguments: 41 ! ---------- 38 42 39 REAL :: vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)40 REAL :: massebx(ip1jmp1, llm), masseby(ip1jm, llm), w(ip1jmp1, llm)41 REAL :: dv(ip1jm, llm), du(ip1jmp1, llm), dteta(ip1jmp1, llm)43 REAL :: vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm) 44 REAL :: massebx(ip1jmp1, llm), masseby(ip1jm, llm), w(ip1jmp1, llm) 45 REAL :: dv(ip1jm, llm), du(ip1jmp1, llm), dteta(ip1jmp1, llm) 42 46 43 ! Local:44 ! ------47 ! Local: 48 ! ------ 45 49 46 REAL :: uav(ip1jmp1, llm), vav(ip1jm, llm), wsur2(ip1jmp1)47 REAL :: unsaire2(ip1jmp1), ge(ip1jmp1)48 REAL :: deuxjour, ww, gt, uu, vv50 REAL :: uav(ip1jmp1, llm), vav(ip1jm, llm), wsur2(ip1jmp1) 51 REAL :: unsaire2(ip1jmp1), ge(ip1jmp1) 52 REAL :: deuxjour, ww, gt, uu, vv 49 53 50 INTEGER :: ij, l54 INTEGER :: ij, l 51 55 52 !-----------------------------------------------------------------------53 ! 2. Calculs preliminaires:54 ! -------------------------56 !----------------------------------------------------------------------- 57 ! 2. Calculs preliminaires: 58 ! ------------------------- 55 59 56 IF (conser) THEN57 deuxjour = 2. * daysec60 IF (conser) THEN 61 deuxjour = 2. * daysec 58 62 59 DO ij = 1, ip1jmp160 unsaire2(ij) = unsaire(ij) * unsaire(ij)61 END DO62 END IF63 DO ij = 1, ip1jmp1 64 unsaire2(ij) = unsaire(ij) * unsaire(ij) 65 END DO 66 END IF 63 67 64 68 65 !------------------ -yy ----------------------------------------------66 ! . Calcul de u69 !------------------ -yy ---------------------------------------------- 70 ! . Calcul de u 67 71 68 DO l = 1, llm 69 DO ij = iip2, ip1jmp1 70 uav(ij, l) = 0.25 * (ucov(ij, l) + ucov(ij - iip1, l)) 72 DO l = 1, llm 73 DO ij = iip2, ip1jmp1 74 uav(ij, l) = 0.25 * (ucov(ij, l) + ucov(ij - iip1, l)) 75 ENDDO 76 DO ij = iip2, ip1jm 77 uav(ij, l) = uav(ij, l) + uav(ij + iip1, l) 78 ENDDO 79 DO ij = 1, iip1 80 uav(ij, l) = 0. 81 uav(ip1jm + ij, l) = 0. 82 ENDDO 71 83 ENDDO 72 DO ij = iip2, ip1jm 73 uav(ij, l) = uav(ij, l) + uav(ij + iip1, l) 84 85 !------------------ -xx ---------------------------------------------- 86 ! . Calcul de v 87 88 DO l = 1, llm 89 DO ij = 2, ip1jm 90 vav(ij, l) = 0.25 * (vcov(ij, l) + vcov(ij - 1, l)) 91 ENDDO 92 DO ij = 1, ip1jm, iip1 93 vav(ij, l) = vav(ij + iim, l) 94 ENDDO 95 DO ij = 1, ip1jm - 1 96 vav(ij, l) = vav(ij, l) + vav(ij + 1, l) 97 ENDDO 98 DO ij = 1, ip1jm, iip1 99 vav(ij + iim, l) = vav(ij, l) 100 ENDDO 74 101 ENDDO 75 DO ij = 1, iip176 uav(ij, l) = 0.77 uav(ip1jm + ij, l) = 0.78 ENDDO79 ENDDO80 102 81 !------------------ -xx ---------------------------------------------- 82 ! . Calcul de v 103 !----------------------------------------------------------------------- 83 104 84 DO l = 1, llm 85 DO ij = 2, ip1jm 86 vav(ij, l) = 0.25 * (vcov(ij, l) + vcov(ij - 1, l)) 87 ENDDO 88 DO ij = 1, ip1jm, iip1 89 vav(ij, l) = vav(ij + iim, l) 90 ENDDO 91 DO ij = 1, ip1jm - 1 92 vav(ij, l) = vav(ij, l) + vav(ij + 1, l) 93 ENDDO 94 DO ij = 1, ip1jm, iip1 95 vav(ij + iim, l) = vav(ij, l) 96 ENDDO 97 ENDDO 98 99 !----------------------------------------------------------------------- 105 DO l = 1, llmm1 100 106 101 107 102 DO l = 1, llmm1 108 ! ...... calcul de - w/2. au niveau l+1 ....... 109 110 DO ij = 1, ip1jmp1 111 wsur2(ij) = - 0.5 * w(ij, l + 1) 112 END DO 103 113 104 114 105 ! ...... calcul de - w/2. au niveau l+1.......115 ! ..................... calcul pour du .................. 106 116 107 DO ij = 1, ip1jmp1 108 wsur2(ij) = - 0.5 * w(ij, l + 1) 117 DO ij = iip2, ip1jm - 1 118 ww = wsur2 (ij) + wsur2(ij + 1) 119 uu = 0.5 * (ucov(ij, l) + ucov(ij, l + 1)) 120 du(ij, l) = du(ij, l) - ww * (uu - uav(ij, l)) / massebx(ij, l) 121 du(ij, l + 1) = du(ij, l + 1) + ww * (uu - uav(ij, l + 1)) / massebx(ij, l + 1) 122 END DO 123 124 ! ..... correction pour du(iip1,j,l) ........ 125 ! ..... du(iip1,j,l)= du(1,j,l) ..... 126 127 !DIR$ IVDEP 128 DO ij = iip1 + iip1, ip1jm, iip1 129 du(ij, l) = du(ij - iim, l) 130 du(ij, l + 1) = du(ij - iim, l + 1) 131 END DO 132 133 ! ................. calcul pour dv ..................... 134 135 DO ij = 1, ip1jm 136 ww = wsur2(ij + iip1) + wsur2(ij) 137 vv = 0.5 * (vcov(ij, l) + vcov(ij, l + 1)) 138 dv(ij, l) = dv(ij, l) - ww * (vv - vav(ij, l)) / masseby(ij, l) 139 dv(ij, l + 1) = dv(ij, l + 1) + ww * (vv - vav(ij, l + 1)) / masseby(ij, l + 1) 140 END DO 141 142 ! 143 144 ! ............................................................ 145 ! ............... calcul pour dh ................... 146 ! ............................................................ 147 148 ! ---z 149 ! calcul de - d( teta * w ) qu'on ajoute a dh 150 ! ............... 151 152 DO ij = 1, ip1jmp1 153 ww = wsur2(ij) * (teta(ij, l) + teta(ij, l + 1)) 154 dteta(ij, l) = dteta(ij, l) - ww 155 dteta(ij, l + 1) = dteta(ij, l + 1) + ww 156 END DO 157 158 IF(conser) THEN 159 DO ij = 1, ip1jmp1 160 ge(ij) = wsur2(ij) * wsur2(ij) * unsaire2(ij) 161 END DO 162 gt = SSUM(ip1jmp1, ge, 1) 163 gtot(l) = deuxjour * SQRT(gt / ip1jmp1) 164 END IF 165 109 166 END DO 110 167 168 END SUBROUTINE advect 111 169 112 ! ..................... calcul pour du .................. 113 114 DO ij = iip2, ip1jm - 1 115 ww = wsur2 (ij) + wsur2(ij + 1) 116 uu = 0.5 * (ucov(ij, l) + ucov(ij, l + 1)) 117 du(ij, l) = du(ij, l) - ww * (uu - uav(ij, l)) / massebx(ij, l) 118 du(ij, l + 1) = du(ij, l + 1) + ww * (uu - uav(ij, l + 1)) / massebx(ij, l + 1) 119 END DO 120 121 ! ..... correction pour du(iip1,j,l) ........ 122 ! ..... du(iip1,j,l)= du(1,j,l) ..... 123 124 !DIR$ IVDEP 125 DO ij = iip1 + iip1, ip1jm, iip1 126 du(ij, l) = du(ij - iim, l) 127 du(ij, l + 1) = du(ij - iim, l + 1) 128 END DO 129 130 ! ................. calcul pour dv ..................... 131 132 DO ij = 1, ip1jm 133 ww = wsur2(ij + iip1) + wsur2(ij) 134 vv = 0.5 * (vcov(ij, l) + vcov(ij, l + 1)) 135 dv(ij, l) = dv(ij, l) - ww * (vv - vav(ij, l)) / masseby(ij, l) 136 dv(ij, l + 1) = dv(ij, l + 1) + ww * (vv - vav(ij, l + 1)) / masseby(ij, l + 1) 137 END DO 138 139 ! 140 141 ! ............................................................ 142 ! ............... calcul pour dh ................... 143 ! ............................................................ 144 145 ! ---z 146 ! calcul de - d( teta * w ) qu'on ajoute a dh 147 ! ............... 148 149 DO ij = 1, ip1jmp1 150 ww = wsur2(ij) * (teta(ij, l) + teta(ij, l + 1)) 151 dteta(ij, l) = dteta(ij, l) - ww 152 dteta(ij, l + 1) = dteta(ij, l + 1) + ww 153 END DO 154 155 IF(conser) THEN 156 DO ij = 1, ip1jmp1 157 ge(ij) = wsur2(ij) * wsur2(ij) * unsaire2(ij) 158 END DO 159 gt = SSUM(ip1jmp1, ge, 1) 160 gtot(l) = deuxjour * SQRT(gt / ip1jmp1) 161 END IF 162 163 END DO 164 165 166 END SUBROUTINE advect 170 END MODULE lmdz_advect
Note: See TracChangeset
for help on using the changeset viewer.
