Changeset 5086 for LMDZ6/branches/Amaury_dev/libf/dyn3d
- Timestamp:
- Jul 19, 2024, 7:54:50 PM (6 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/dyn3d
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3d/advect.F
r2622 r5086 57 57 deuxjour = 2. * daysec 58 58 59 DO 1ij = 1, ip1jmp159 DO ij = 1, ip1jmp1 60 60 unsaire2(ij) = unsaire(ij) * unsaire(ij) 61 1 CONTINUE61 END DO 62 62 END IF 63 63 … … 100 100 101 101 c 102 DO 20l = 1, llmm1102 DO l = 1, llmm1 103 103 104 104 105 105 c ...... calcul de - w/2. au niveau l+1 ....... 106 106 107 DO 5ij = 1, ip1jmp1107 DO ij = 1, ip1jmp1 108 108 wsur2( ij ) = - 0.5 * w( ij,l+1 ) 109 5 CONTINUE109 END DO 110 110 111 111 112 112 c ..................... calcul pour du .................. 113 113 114 DO 6ij = iip2 ,ip1jm-1114 DO ij = iip2 ,ip1jm-1 115 115 ww = wsur2 ( ij ) + wsur2( ij+1 ) 116 116 uu = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) ) 117 117 du(ij,l) = du(ij,l) - ww * ( uu - uav(ij, l ) )/massebx(ij, l ) 118 118 du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1) 119 6 CONTINUE119 END DO 120 120 121 121 c ..... correction pour du(iip1,j,l) ........ … … 123 123 124 124 CDIR$ IVDEP 125 DO 7ij = iip1 +iip1, ip1jm, iip1125 DO ij = iip1 +iip1, ip1jm, iip1 126 126 du( ij, l ) = du( ij -iim, l ) 127 127 du( ij,l+1 ) = du( ij -iim,l+1 ) 128 7 CONTINUE128 END DO 129 129 130 130 c ................. calcul pour dv ..................... 131 131 132 DO 8ij = 1, ip1jm132 DO ij = 1, ip1jm 133 133 ww = wsur2( ij+iip1 ) + wsur2( ij ) 134 134 vv = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) ) 135 135 dv(ij,l) = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l ) 136 136 dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1) 137 8 CONTINUE137 END DO 138 138 139 139 c … … 147 147 c ............... 148 148 149 DO 15ij = 1, ip1jmp1149 DO ij = 1, ip1jmp1 150 150 ww = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) ) 151 151 dteta(ij, l ) = dteta(ij, l ) - ww 152 152 dteta(ij,l+1) = dteta(ij,l+1) + ww 153 15 CONTINUE153 END DO 154 154 155 155 IF( conser) THEN 156 DO 17ij = 1,ip1jmp1156 DO ij = 1,ip1jmp1 157 157 ge(ij) = wsur2(ij) * wsur2(ij) * unsaire2(ij) 158 17 CONTINUE158 END DO 159 159 gt = SSUM( ip1jmp1,ge,1 ) 160 160 gtot(l) = deuxjour * SQRT( gt/ip1jmp1 ) 161 161 END IF 162 162 163 20 CONTINUE163 END DO 164 164 165 165 RETURN -
LMDZ6/branches/Amaury_dev/libf/dyn3d/dteta1.F
r2603 r5086 32 32 c 33 33 34 DO 5l = 1,llm34 DO l = 1,llm 35 35 36 DO 1ij = iip2, ip1jm - 136 DO ij = iip2, ip1jm - 1 37 37 hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l) + teta(ij+1,l) ) 38 1 CONTINUE38 END DO 39 39 40 40 c .... correction pour hbxu(iip1,j,l) ..... … … 42 42 43 43 CDIR$ IVDEP 44 DO 2ij = iip1+ iip1, ip1jm, iip144 DO ij = iip1+ iip1, ip1jm, iip1 45 45 hbxu( ij, l ) = hbxu( ij - iim, l ) 46 2 CONTINUE46 END DO 47 47 48 48 49 DO 3ij = 1,ip1jm49 DO ij = 1,ip1jm 50 50 hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+ teta(ij +iip1,l) ) 51 3 CONTINUE51 END DO 52 52 53 5 CONTINUE53 END DO 54 54 55 55 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/dudv1.F
r1907 r5086 27 27 c 28 28 c 29 DO 10l = 1,llm29 DO l = 1,llm 30 30 c 31 DO 2ij = iip2, ip1jm - 131 DO ij = iip2, ip1jm - 1 32 32 du( ij,l ) = 0.125 *( vorpot(ij-iip1, l) + vorpot( ij, l) ) * 33 33 * ( pbarv(ij-iip1, l) + pbarv(ij-iim, l) + 34 34 * pbarv( ij , l) + pbarv(ij+ 1 , l) ) 35 2 CONTINUE35 END DO 36 36 c 37 DO 3ij = 1, ip1jm - 137 DO ij = 1, ip1jm - 1 38 38 dv( ij+1,l ) = - 0.125 *( vorpot(ij, l) + vorpot(ij+1, l) ) * 39 39 * ( pbaru(ij, l) + pbaru(ij+1 , l) + 40 40 * pbaru(ij+iip1, l) + pbaru(ij+iip2, l) ) 41 3 CONTINUE41 END DO 42 42 c 43 43 c .... correction pour dv( 1,j,l ) ..... … … 45 45 c 46 46 CDIR$ IVDEP 47 DO 4ij = 1, ip1jm, iip147 DO ij = 1, ip1jm, iip1 48 48 dv( ij,l ) = dv( ij + iim, l ) 49 4 CONTINUE49 END DO 50 50 c 51 10 CONTINUE51 END DO 52 52 RETURN 53 53 END -
LMDZ6/branches/Amaury_dev/libf/dyn3d/dudv2.F
r2600 r5086 34 34 c 35 35 c 36 DO 5l = 1,llm36 DO l = 1,llm 37 37 c 38 DO 2ij = iip2, ip1jm - 138 DO ij = iip2, ip1jm - 1 39 39 du(ij,l) = du(ij,l) + 0.5* ( teta( ij,l ) + teta( ij+1,l ) ) * 40 40 * ( pkf( ij,l ) - pkf(ij+1,l) ) + bern(ij,l) - bern(ij+1,l) 41 2 CONTINUE41 END DO 42 42 c 43 43 c … … 46 46 c 47 47 CDIR$ IVDEP 48 DO 3ij = iip1+ iip1, ip1jm, iip148 DO ij = iip1+ iip1, ip1jm, iip1 49 49 du( ij,l ) = du( ij - iim,l ) 50 3 CONTINUE50 END DO 51 51 c 52 52 c 53 DO 4ij = 1,ip1jm53 DO ij = 1,ip1jm 54 54 dv( ij,l) = dv(ij,l) + 0.5 * ( teta(ij,l) + teta( ij+iip1,l ) ) * 55 55 * ( pkf(ij+iip1,l) - pkf( ij,l ) ) 56 56 * + bern( ij+iip1,l ) - bern( ij ,l ) 57 4 CONTINUE57 END DO 58 58 c 59 5 CONTINUE59 END DO 60 60 c 61 61 RETURN -
LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F
r5082 r5086 74 74 a(i) = rlonuo(i-1) 75 75 b(i) = rlonuo(i) 76 end do76 END DO 77 77 78 78 d(1) = pi/2 … … 80 80 c(j) = rlatvo(j) 81 81 d(j+1) = rlatvo(j) 82 end do82 END DO 83 83 c(jmo+1) = -pi/2 84 84 … … 91 91 an(i) = rlonun(i-1) 92 92 bn(i) = rlonun(i) 93 end do93 END DO 94 94 95 95 dn(1) = pi/2 … … 97 97 cn(j) = rlatvn(j) 98 98 dn(j+1) = rlatvn(j) 99 end do99 END DO 100 100 cn(jmn+1) = -pi/2 101 101 … … 105 105 do jj = 1,jmn+1 106 106 airen(ii,jj) = (bn(ii)-an(ii))*(sin(dn(jj))-sin(cn(jj))) 107 end do108 end do107 END DO 108 END DO 109 109 110 110 c Calcul de la surface des intersections … … 151 151 intersec(ktotal)=(bb-aa)*(sin(dd)-sin(cc)) 152 152 end if 153 end do154 end do153 END DO 154 END DO 155 155 end if 156 end do157 end do156 END DO 157 END DO 158 158 159 159 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/interp_horiz.F
r1907 r5086 73 73 do ii=1, imn+1 74 74 varn(ii,jj,l) =0. 75 end do76 end do77 end do75 END DO 76 END DO 77 END DO 78 78 79 79 c Interpolation horizontale … … 88 88 varn(iik(k),jjk(k),l) = varn(iik(k),jjk(k),l) 89 89 & + varo(ik(k), jk(k),l)*intersec(k)/airen(iik(k),jjk(k)) 90 end do91 end do90 END DO 91 END DO 92 92 93 93 c Une seule valeur au pole pour les variables ! : … … 99 99 totn = totn + varn(ii,1,l) 100 100 tots = tots + varn (ii,jmn+1,l) 101 end do101 END DO 102 102 do ii =1, imn+1 103 103 varn(ii,1,l) = totn/REAL(imn+1) 104 104 varn(ii,jmn+1,l) = tots/REAL(imn+1) 105 end do106 end do105 END DO 106 END DO 107 107 108 108 … … 115 115 !! do ii=1, imn+1 116 116 !! airetest(ii,jj) =0. 117 !! end do118 !! end do117 !! END DO 118 !! END DO 119 119 !! PRINT *, 'ktotal = ', ktotal 120 120 !! PRINT *, 'jmn+1 =', jmn+1, 'imn+1', imn+1 … … 136 136 !! aire_ok = .false. 137 137 !! end if 138 !! end do139 !! end do138 !! END DO 139 !! END DO 140 140 !! ! if (aire_ok) write(*,*) 'INTERP. HORIZ. : AIRES OK' 141 141 !! 99 continue -
LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F
r5082 r5086 65 65 c Eventuellement, faire l'extrapolation a partir des deux couches 66 66 c les plus basses ou les deux couches les plus hautes: 67 DO 130i = 1, ilon67 DO i = 1, ilon 68 68 cIM IF ( ABS(pres-pgcm(i,ilev) ) .LT. 69 69 IF ( ABS(pres-pgcm(i,ilev) ) > … … 77 77 cIM PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)', 78 78 cIM .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1)) 79 130 CONTINUE80 DO 150k = 1, ilev-181 DO 140i = 1, ilon79 END DO 80 DO k = 1, ilev-1 81 DO i = 1, ilon 82 82 pbot = pgcm(i,k) 83 83 ptop = pgcm(i,k+1) … … 87 87 lb(i) = k 88 88 ENDIF 89 140 CONTINUE90 150 CONTINUE89 END DO 90 END DO 91 91 c 92 92 c Interpolation lineaire: -
LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F
r5082 r5086 65 65 c Eventuellement, faire l'extrapolation a partir des deux couches 66 66 c les plus basses ou les deux couches les plus hautes: 67 DO 130i = 1, ilon67 DO i = 1, ilon 68 68 cIM IF ( ABS(pres-pgcm(i,ilev) ) .LT. 69 69 IF ( ABS(pres-pgcm(i,ilev) ) > … … 77 77 cIM PRINT*,'i, ABS(pres-pgcm),ABS(pres-pgcm)', 78 78 cIM .i, ABS(pres-pgcm(i,ilev)),ABS(pres-pgcm(i,1)) 79 130 CONTINUE80 DO 150k = 1, ilev-181 DO 140i = 1, ilon79 END DO 80 DO k = 1, ilev-1 81 DO i = 1, ilon 82 82 pbot = pgcm(i,k) 83 83 ptop = pgcm(i,k+1) … … 87 87 lb(i) = k 88 88 ENDIF 89 140 CONTINUE90 150 CONTINUE89 END DO 90 END DO 91 91 c 92 92 c Interpolation lineaire:
Note: See TracChangeset
for help on using the changeset viewer.