/[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 89 by guez, Wed Mar 5 14:57:53 2014 UTC revision 90 by guez, Wed Mar 12 21:16:36 2014 UTC
# Line 15  contains Line 15  contains
15    
16    SUBROUTINE etat0    SUBROUTINE etat0
17    
18      ! From "etat0_netcdf.F", version 1.3 2005/05/25 13:10:09      ! From "etat0_netcdf.F", version 1.3, 2005/05/25 13:10:09
19    
20      use caldyn0_m, only: caldyn0      use caldyn0_m, only: caldyn0
21      use comconst, only: cpp, kappa, iniconst      use comconst, only: cpp, kappa, iniconst
# Line 40  contains Line 40  contains
40      use netcdf, only: nf90_nowrite      use netcdf, only: nf90_nowrite
41      use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, &      use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, &
42           nf95_inq_varid, nf95_open           nf95_inq_varid, nf95_open
43      use nr_util, only: pi      use nr_util, only: pi, assert
44      use paramet_m, only: ip1jm, ip1jmp1      use paramet_m, only: ip1jm, ip1jmp1
45      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
46      use pressure_var, only: pls, p3d      use pressure_var, only: pls, p3d
# Line 58  contains Line 58  contains
58    
59      REAL latfi(klon), lonfi(klon)      REAL latfi(klon), lonfi(klon)
60      ! (latitude and longitude of a point of the scalar grid identified      ! (latitude and longitude of a point of the scalar grid identified
61      ! by a simple index, in °)      ! by a simple index, in degrees)
62    
63      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta
64      REAL vcov(iim + 1, jjm, llm)      REAL vcov(iim + 1, jjm, llm)
# Line 93  contains Line 93  contains
93      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
94      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)
95    
96      ! Déclarations pour lecture glace de mer :      ! D\'eclarations pour lecture glace de mer :
97      INTEGER iml_lic, jml_lic      INTEGER iml_lic, jml_lic
98      INTEGER ncid, varid      INTEGER ncid, varid
99      REAL, pointer:: dlon_lic(:), dlat_lic(:)      REAL, pointer:: dlon_lic(:), dlat_lic(:)
# Line 148  contains Line 148  contains
148      ! Compute pressure on intermediate levels:      ! Compute pressure on intermediate levels:
149      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps      forall(l = 1: llm + 1) p3d(:, :, l) = ap(l) + bp(l) * ps
150      CALL exner_hyb(ps, p3d, pks, pk)      CALL exner_hyb(ps, p3d, pks, pk)
151      IF (MINVAL(pk) == MAXVAL(pk)) then      call assert(MINVAL(pk) /= MAXVAL(pk), '"pk" should not be constant')
        print *, '"pk" should not be constant'  
        stop 1  
     end IF  
152    
153      pls = preff * (pk / cpp)**(1. / kappa)      pls = preff * (pk / cpp)**(1. / kappa)
154      PRINT *, "minval(pls) = ", minval(pls)      PRINT *, "minval(pls) = ", minval(pls)
# Line 177  contains Line 174  contains
174              / apols              / apols
175      ENDDO      ENDDO
176    
177      ! Calcul de l'humidité à saturation :      ! Calcul de l'humidit\'e \`a saturation :
178      qsat = q_sat(t3d, pls)      qsat = q_sat(t3d, pls)
179      PRINT *, "minval(qsat) = ", minval(qsat)      PRINT *, "minval(qsat) = ", minval(qsat)
180      print *, "maxval(qsat) = ", maxval(qsat)      print *, "maxval(qsat) = ", maxval(qsat)
# Line 238  contains Line 235  contains
235    
236      call nf95_close(ncid)      call nf95_close(ncid)
237    
238      ! Interpolation sur la grille T du modèle :      ! Interpolation sur la grille T du mod\`ele :
239      PRINT *, 'Dimensions de "landiceref.nc"'      PRINT *, 'Dimensions de "landiceref.nc"'
240      print *, "iml_lic = ", iml_lic      print *, "iml_lic = ", iml_lic
241      print *, "jml_lic = ", jml_lic      print *, "jml_lic = ", jml_lic
242    
243      ! Si les coordonnées sont en degrés, on les transforme :      ! Si les coordonn\'ees sont en degr\'es, on les transforme :
244      IF (MAXVAL(dlon_lic) > pi) THEN      IF (MAXVAL(dlon_lic) > pi) THEN
245         dlon_lic = dlon_lic * pi / 180.         dlon_lic = dlon_lic * pi / 180.
246      ENDIF      ENDIF
# Line 260  contains Line 257  contains
257      ! Passage sur la grille physique      ! Passage sur la grille physique
258      pctsrf = 0.      pctsrf = 0.
259      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
260      ! Adéquation avec le maque terre/mer      ! Ad\'equation avec le maque terre/mer
261      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.
262      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.
263      pctsrf(:, is_ter) = zmasq      pctsrf(:, is_ter) = zmasq
# Line 277  contains Line 274  contains
274         end where         end where
275      end where      end where
276    
277      ! Sous-surface océan et glace de mer (pour démarrer on met glace      ! Sous-surface oc\'ean et glace de mer (pour d\'emarrer on met glace
278      ! de mer à 0) :      ! de mer \`a 0) :
279      pctsrf(:, is_oce) = 1. - zmasq      pctsrf(:, is_oce) = 1. - zmasq
280      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.
281    
282      ! Vérification que somme des sous-surfaces vaut 1 :      ! V\'erification que somme des sous-surfaces vaut 1 :
283      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)
284      IF (ji /= 0) then      IF (ji /= 0) then
285         PRINT *, 'Problème répartition sous maille pour ', ji, 'points'         PRINT *, 'Probl\`eme r\'epartition sous maille pour ', ji, 'points'
286      end IF      end IF
287    
288      ! Calcul intermédiaire :      ! Calcul interm\'ediaire :
289      CALL massdair(p3d, masse)      CALL massdair(p3d, masse)
290    
291      print *, 'ALPHAX = ', alphax      print *, 'ALPHAX = ', alphax
Legend:
Removed from v.89  
changed lines
  Added in v.90
  ViewVC Help
Powered by ViewVC 1.1.21