/[lmdze]/trunk/dyn3d/etat0.f
ViewVC logotype

Diff of /trunk/dyn3d/etat0.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 72 by guez, Tue Jul 23 13:00:07 2013 UTC revision 73 by guez, Fri Nov 15 17:48:30 2013 UTC
# Line 61  contains Line 61  contains
61      ! (latitude and longitude of a point of the scalar grid identified      ! (latitude and longitude of a point of the scalar grid identified
62      ! by a simple index, in °)      ! by a simple index, in °)
63    
64      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, tpot      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta
65      REAL vcov(iim + 1, jjm, llm)      REAL vcov(iim + 1, jjm, llm)
66    
67      REAL q(iim + 1, jjm + 1, llm, nqmx)      REAL q(iim + 1, jjm + 1, llm, nqmx)
# Line 84  contains Line 84  contains
84      REAL rugmer(klon)      REAL rugmer(klon)
85      real, dimension(iim + 1, jjm + 1):: relief, zstd_2d, zsig_2d, zgam_2d      real, dimension(iim + 1, jjm + 1):: relief, zstd_2d, zsig_2d, zgam_2d
86      real, dimension(iim + 1, jjm + 1):: zthe_2d, zpic_2d, zval_2d      real, dimension(iim + 1, jjm + 1):: zthe_2d, zpic_2d, zval_2d
87      real, dimension(iim + 1, jjm + 1):: tsol_2d, qsol_2d, psol      real, dimension(iim + 1, jjm + 1):: tsol_2d, qsol_2d, ps
88      REAL zmea(klon), zstd(klon)      REAL zmea(klon), zstd(klon)
89      REAL zsig(klon), zgam(klon)      REAL zsig(klon), zgam(klon)
90      REAL zthe(klon)      REAL zthe(klon)
# Line 145  contains Line 145  contains
145      PRINT *, 'Masque construit'      PRINT *, 'Masque construit'
146    
147      call start_init_phys(tsol_2d, qsol_2d)      call start_init_phys(tsol_2d, qsol_2d)
148      CALL start_init_dyn(tsol_2d, psol)      CALL start_init_dyn(tsol_2d, ps)
149    
150      ! Compute pressure on intermediate levels:      ! Compute pressure on intermediate levels:
151      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * psol      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps
152      CALL exner_hyb(psol, p3d, pks, pk)      CALL exner_hyb(ps, p3d, pks, pk)
153      IF (MINVAL(pk) == MAXVAL(pk)) then      IF (MINVAL(pk) == MAXVAL(pk)) then
154         print *, '"pk" should not be constant'         print *, '"pk" should not be constant'
155         stop 1         stop 1
# Line 171  contains Line 171  contains
171      PRINT *,  'minval(t3d) = ', minval(t3d)      PRINT *,  'minval(t3d) = ', minval(t3d)
172      print *, "maxval(t3d) = ", maxval(t3d)      print *, "maxval(t3d) = ", maxval(t3d)
173    
174      tpot(:iim, :, :) = t3d(:iim, :, :) * cpp / pk(:iim, :, :)      teta(:iim, :, :) = t3d(:iim, :, :) * cpp / pk(:iim, :, :)
175      tpot(iim + 1, :, :) = tpot(1, :, :)      teta(iim + 1, :, :) = teta(1, :, :)
176      DO l=1, llm      DO l = 1, llm
177         tpot(:, 1, l) = SUM(aire_2d(:, 1) * tpot(:, 1, l)) / apoln         teta(:, 1, l) = SUM(aire_2d(:, 1) * teta(:, 1, l)) / apoln
178         tpot(:, jjm + 1, l) = SUM(aire_2d(:, jjm + 1) * tpot(:, jjm + 1, l)) &         teta(:, jjm + 1, l) = SUM(aire_2d(:, jjm + 1) * teta(:, jjm + 1, l)) &
179              / apols              / apols
180      ENDDO      ENDDO
181    
# Line 246  contains Line 246  contains
246      print *, "jml_lic = ", jml_lic      print *, "jml_lic = ", jml_lic
247    
248      ! Si les coordonnées sont en degrés, on les transforme :      ! Si les coordonnées sont en degrés, on les transforme :
249      IF (MAXVAL( dlon_lic ) > pi)  THEN      IF (MAXVAL(dlon_lic) > pi)  THEN
250         dlon_lic = dlon_lic * pi / 180.         dlon_lic = dlon_lic * pi / 180.
251      ENDIF      ENDIF
252      IF (maxval( dlat_lic ) > pi) THEN      IF (maxval(dlat_lic) > pi) THEN
253         dlat_lic = dlat_lic * pi/ 180.         dlat_lic = dlat_lic * pi/ 180.
254      ENDIF      ENDIF
255    
# Line 263  contains Line 263  contains
263      pctsrf = 0.      pctsrf = 0.
264      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
265      ! Adéquation avec le maque terre/mer      ! Adéquation avec le maque terre/mer
266      WHERE (pctsrf(:, is_lic) < EPSFRA ) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.
267      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.
268      pctsrf(:, is_ter) = zmasq      pctsrf(:, is_ter) = zmasq
269      where (zmasq > EPSFRA)      where (zmasq > EPSFRA)
# Line 284  contains Line 284  contains
284      pctsrf(:, is_oce) = 1. - zmasq      pctsrf(:, is_oce) = 1. - zmasq
285      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.
286    
287      ! Vérification que somme des sous-surfaces vaut 1:      ! Vérification que somme des sous-surfaces vaut 1 :
288      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)
289      IF (ji /= 0) then      IF (ji /= 0) then
290         PRINT *, 'Problème répartition sous maille pour ', ji, 'points'         PRINT *, 'Problème répartition sous maille pour ', ji, 'points'
291      end IF      end IF
292    
293      ! Calcul intermédiaire:      ! Calcul intermédiaire :
294      CALL massdair(p3d, masse)      CALL massdair(p3d, masse)
295    
296      print *, 'ALPHAX = ', alphax      print *, 'ALPHAX = ', alphax
# Line 307  contains Line 307  contains
307      day_ref = dayref      day_ref = dayref
308      annee_ref = anneeref      annee_ref = anneeref
309    
310      CALL geopot(tpot, pk , pks,  phis, phi)      CALL geopot(teta, pk , pks,  phis, phi)
311      CALL caldyn0(ucov, vcov, tpot, psol, masse, pk, phis, phi, w, pbaru, &      CALL caldyn0(ucov, vcov, teta, ps, masse, pk, phis, phi, w, pbaru, &
312           pbarv)           pbarv)
313      CALL dynredem0("start.nc", dayref, phis)      CALL dynredem0("start.nc", dayref, phis)
314      CALL dynredem1("start.nc", vcov, ucov, tpot, q, masse, psol, itau=0)      CALL dynredem1("start.nc", vcov, ucov, teta, q, masse, ps, itau=0)
315    
316      ! Ecriture état initial physique:      ! Ecriture état initial physique:
317      print *, "iphysiq = ", iphysiq      print *, "iphysiq = ", iphysiq
Legend:
Removed from v.72  
changed lines
  Added in v.73
  ViewVC Help
Powered by ViewVC 1.1.21