/[lmdze]/trunk/Sources/phylmd/Orography/start_init_orog.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Orography/start_init_orog.f

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

revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC revision 78 by guez, Wed Feb 5 17:51:07 2014 UTC
# Line 3  MODULE start_init_orog_m Line 3  MODULE start_init_orog_m
3    ! From startvar.F, version 1.4    ! From startvar.F, version 1.4
4    ! 2006/01/27 15:14:22 Fairhead    ! 2006/01/27 15:14:22 Fairhead
5    
6      use dimens_m, only: iim, jjm
7    
8    IMPLICIT NONE    IMPLICIT NONE
9    
10    REAL, ALLOCATABLE, SAVE:: mask(:, :) ! fraction of land (iim + 1, jjm + 1)    REAL, SAVE:: mask(iim + 1, jjm + 1) ! interpolated fraction of land
11    REAL, ALLOCATABLE, SAVE:: phis(:, :) ! surface geopotential, in m2 s-2  
12      private iim, jjm
13    
14  CONTAINS  CONTAINS
15    
16    SUBROUTINE start_init_orog(relief, zstd_2d, zsig_2d, zgam_2d, zthe_2d, &    SUBROUTINE start_init_orog(phis, zmea_2d, zstd_2d, zsig_2d, zgam_2d, &
17         zpic_2d, zval_2d)         zthe_2d, zpic_2d, zval_2d)
18    
19      use conf_dat2d_m, only: conf_dat2d      use conf_dat2d_m, only: conf_dat2d
20      use comgeom, only: rlatu, rlonv      use comgeom, only: rlatu, rlonv
     use dimens_m, only: iim, jjm  
21      use grid_noro_m, only: grid_noro      use grid_noro_m, only: grid_noro
22      use indicesol, only: epsfra      use indicesol, only: epsfra
23      use netcdf, only: nf90_nowrite      use netcdf, only: nf90_nowrite
24      use netcdf95, only: nf95_open, nf95_gw_var, nf95_inq_varid, nf95_close      use netcdf95, only: nf95_open, nf95_gw_var, nf95_inq_varid, nf95_close
25      use nr_util, only: pi      use nr_util, only: pi, assert
26    
27        REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)
28        ! surface geopotential, in m2 s-2
29    
30      REAL, intent(out):: relief(:, :) ! (iim + 1, jjm + 1) orographie moyenne      REAL, intent(out):: zmea_2d(:, :) ! (iim + 1, jjm + 1) orographie moyenne
31    
32      REAL, intent(out):: zstd_2d(:, :) ! (iim + 1, jjm + 1)      REAL, intent(out):: zstd_2d(:, :) ! (iim + 1, jjm + 1)
33      ! (deviation standard de l'orographie sous-maille)      ! (deviation standard de l'orographie sous-maille)
# Line 48  CONTAINS Line 53  CONTAINS
53      INTEGER iml_rel      INTEGER iml_rel
54      INTEGER jml_rel      INTEGER jml_rel
55      INTEGER ncid, varid      INTEGER ncid, varid
56      REAL, pointer:: relief_hi(:, :)      REAL, pointer:: relief(:, :)
57      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
58      REAL, pointer:: lon_ini(:), lat_ini(:)      REAL, pointer:: lon_ini(:), lat_ini(:)
59    
# Line 56  CONTAINS Line 61  CONTAINS
61    
62      print *, "Call sequence information: start_init_orog"      print *, "Call sequence information: start_init_orog"
63    
64      if (any((/size(relief, 1), size(zstd_2d, 1), size(zsig_2d, 1), &      call assert((/size(phis, 1), size(zmea_2d, 1), size(zstd_2d, 1), &
65           size(zgam_2d, 1), size(zthe_2d, 1), size(zpic_2d, 1), &           size(zsig_2d, 1), size(zgam_2d, 1), size(zthe_2d, 1), &
66           size(zval_2d, 1)/) /= iim + 1)) stop "start_init_orog size 1"           size(zpic_2d, 1), size(zval_2d, 1)/) == iim + 1, "start_init_orog iim")
67      if (any((/size(relief, 2), size(zstd_2d, 2), size(zsig_2d, 2), &      call assert((/size(phis, 2), size(zmea_2d, 2), size(zstd_2d, 2), &
68           size(zgam_2d, 2), size(zthe_2d, 2), size(zpic_2d, 2), &           size(zsig_2d, 2), size(zgam_2d, 2), size(zthe_2d, 2), &
69           size(zval_2d, 2)/) /= jjm + 1)) stop "start_init_orog size 2"           size(zpic_2d, 2), size(zval_2d, 2)/) == jjm + 1, "start_init_orog jjm")
70    
71      print *, 'Reading the high resolution orography...'      print *, 'Reading the high resolution orography...'
72    
# Line 78  CONTAINS Line 83  CONTAINS
83      jml_rel = size(lat_ini)      jml_rel = size(lat_ini)
84    
85      call nf95_inq_varid(ncid, "RELIEF", varid)      call nf95_inq_varid(ncid, "RELIEF", varid)
86      call nf95_gw_var(ncid, varid, relief_hi)      call nf95_gw_var(ncid, varid, relief)
87    
88      call nf95_close(ncid)      call nf95_close(ncid)
89    
90      ALLOCATE(lon_rad(iml_rel))      ALLOCATE(lon_rad(iml_rel))
91      ALLOCATE(lat_rad(jml_rel))      ALLOCATE(lat_rad(jml_rel))
92    
93      CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, relief_hi , &      CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, relief , &
94           interbar=.FALSE.)           interbar=.FALSE.)
95      deallocate(lon_ini, lat_ini) ! pointers      deallocate(lon_ini, lat_ini) ! pointers
96    
97      print *, 'Compute all the parameters needed for the gravity wave drag code'      print *, 'Compute all the parameters needed for the gravity wave drag code'
98    
99      ! Interpolated fields:      CALL grid_noro(lon_rad, lat_rad, relief, rlonv, rlatu, phis, zmea_2d, &
     ALLOCATE(phis(iim + 1, jjm + 1))  
     ALLOCATE(mask(iim + 1, jjm + 1))  
   
     CALL grid_noro(lon_rad, lat_rad, relief_hi, rlonv, rlatu, phis, relief, &  
100           zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, zval_2d, mask)           zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, zval_2d, mask)
101      deallocate(relief_hi) ! pointer      deallocate(relief) ! pointer
   
     phis(iim + 1, :) = phis(1, :)  
102      phis(:, :) = phis(:, :) * 9.81      phis(:, :) = phis(:, :) * 9.81
103    
104      mask(2:, 1) = mask(1, 1) ! north pole      mask(2:, 1) = mask(1, 1) ! north pole
Legend:
Removed from v.76  
changed lines
  Added in v.78
  ViewVC Help
Powered by ViewVC 1.1.21