/[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 39 by guez, Tue Jan 25 15:11:05 2011 UTC revision 68 by guez, Wed Nov 14 16:59:30 2012 UTC
# Line 16  CONTAINS Line 16  CONTAINS
16      use conf_dat2d_m, only: conf_dat2d      use conf_dat2d_m, only: conf_dat2d
17      use comgeom, only: rlatu, rlonv      use comgeom, only: rlatu, rlonv
18      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
     USE flincom, only: flininfo, flinopen_nozoom, flinclo  
     use flinget_m, only: flinget  
19      use grid_noro_m, only: grid_noro      use grid_noro_m, only: grid_noro
20      use indicesol, only: epsfra      use indicesol, only: epsfra
21        use netcdf, only: nf90_nowrite
22        use netcdf95, only: nf95_open, nf95_gw_var, nf95_inq_varid, nf95_close
23      use nr_util, only: pi      use nr_util, only: pi
24    
25      REAL, intent(out):: relief(:, :) ! orographie moyenne      REAL, intent(out):: relief(:, :) ! (iim + 1, jjm + 1) orographie moyenne
26    
27      REAL, intent(out):: zstd_2d(:, :)      REAL, intent(out):: zstd_2d(:, :) ! (iim + 1, jjm + 1)
28      ! (deviation standard de l'orographie sous-maille)      ! (deviation standard de l'orographie sous-maille)
29    
30      REAL, intent(out):: zsig_2d(:, :)      REAL, intent(out):: zsig_2d(:, :) ! (iim + 1, jjm + 1)
31      ! (pente de l'orographie sous-maille)      ! (pente de l'orographie sous-maille)
32            
33      REAL, intent(out):: zgam_2d(:, :)      REAL, intent(out):: zgam_2d(:, :) ! (iim + 1, jjm + 1)
34      ! (anisotropie de l'orographie sous maille)      ! (anisotropie de l'orographie sous maille)
35    
36      REAL, intent(out):: zthe_2d(:, :)      REAL, intent(out):: zthe_2d(:, :) ! (iim + 1, jjm + 1)
37      ! (orientation de l'axe oriente dans la direction de plus grande      ! (orientation de l'axe oriente dans la direction de plus grande
38      ! pente de l'orographie sous maille)      ! pente de l'orographie sous maille)
39    
40      REAL, intent(out):: zpic_2d(:, :) ! hauteur pics de la SSO      REAL, intent(out):: zpic_2d(:, :) ! (iim + 1, jjm + 1)
41      REAL, intent(out):: zval_2d(:, :) ! hauteur vallees de la SSO      ! hauteur pics de la SSO
42    
43        REAL, intent(out):: zval_2d(:, :) ! (iim + 1, jjm + 1)
44        ! hauteur vallees de la SSO
45    
46      ! Local:      ! Local:
47    
48      INTEGER, SAVE:: iml_rel      INTEGER iml_rel
49      INTEGER, SAVE:: jml_rel      INTEGER jml_rel
50      REAL lev(1), date, dt      INTEGER ncid, varid
51      INTEGER itau(1), fid      REAL, pointer:: relief_hi(:, :)
     INTEGER  llm_tmp, ttm_tmp  
     REAL, ALLOCATABLE:: relief_hi(:, :)  
52      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
53      REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)      REAL, pointer:: lon_ini(:), lat_ini(:)
     REAL, ALLOCATABLE:: lon_rel(:, :), lat_rel(:, :)  
54    
55      !-----------------------------------      !-----------------------------------
56    
# Line 63  CONTAINS Line 63  CONTAINS
63           size(zgam_2d, 2), size(zthe_2d, 2), size(zpic_2d, 2), &           size(zgam_2d, 2), size(zthe_2d, 2), size(zpic_2d, 2), &
64           size(zval_2d, 2)/) /= jjm + 1)) stop "start_init_orog size 2"           size(zval_2d, 2)/) /= jjm + 1)) stop "start_init_orog size 2"
65    
66      print *, 'Reading the high resolution orography'      print *, 'Reading the high resolution orography...'
     CALL flininfo('Relief.nc', iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)  
67    
68      ALLOCATE(lat_rel(iml_rel, jml_rel))      call nf95_open('Relief.nc', nf90_nowrite, ncid)
     ALLOCATE(lon_rel(iml_rel, jml_rel))  
     ALLOCATE(relief_hi(iml_rel, jml_rel))  
   
     CALL flinopen_nozoom(iml_rel, jml_rel, llm_tmp, &  
          lon_rel, lat_rel, lev, ttm_tmp, itau, date, dt, fid)  
     ! 'RELIEF': high resolution orography  
     CALL flinget(fid, 'RELIEF', iml_rel, jml_rel, llm_tmp, ttm_tmp, 1, 1, &  
          relief_hi)  
     CALL flinclo(fid)  
69    
70      ! In case we have a file which is in degrees we do the transformation:      call nf95_inq_varid(ncid, "longitude", varid)
71        call nf95_gw_var(ncid, varid, lon_ini)
72        lon_ini = lon_ini * pi / 180. ! convert to rad
73        iml_rel = size(lon_ini)
74    
75      ALLOCATE(lon_rad(iml_rel))      call nf95_inq_varid(ncid, "latitude", varid)
76      ALLOCATE(lon_ini(iml_rel))      call nf95_gw_var(ncid, varid, lat_ini)
77        lat_ini = lat_ini * pi / 180. ! convert to rad
78        jml_rel = size(lat_ini)
79    
80      IF (MAXVAL(lon_rel(:, :)) > pi) THEN      call nf95_inq_varid(ncid, "RELIEF", varid)
81         lon_ini(:) = lon_rel(:, 1) * pi / 180.      call nf95_gw_var(ncid, varid, relief_hi)
     ELSE  
        lon_ini(:) = lon_rel(:, 1)  
     ENDIF  
82    
83      ALLOCATE(lat_rad(jml_rel))      call nf95_close(ncid)
     ALLOCATE(lat_ini(jml_rel))  
84    
85      IF (MAXVAL(lat_rel(:, :)) > pi) THEN      ALLOCATE(lon_rad(iml_rel))
86         lat_ini(:) = lat_rel(1, :) * pi / 180.      ALLOCATE(lat_rad(jml_rel))
     ELSE  
        lat_ini(:) = lat_rel(1, :)  
     ENDIF  
87    
88      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_hi , &
89           interbar=.FALSE.)           interbar=.FALSE.)
90        deallocate(lon_ini, lat_ini) ! pointers
91    
92      print *, 'Compute all the parameters needed for the gravity wave drag code'      print *, 'Compute all the parameters needed for the gravity wave drag code'
93    
94      ! Allocate the data we need to put in the interpolated fields:      ! Interpolated fields:
95      ALLOCATE(phis(iim + 1, jjm + 1))      ALLOCATE(phis(iim + 1, jjm + 1))
96      ALLOCATE(mask(iim + 1, jjm + 1))      ALLOCATE(mask(iim + 1, jjm + 1))
97    
98      CALL grid_noro(lon_rad, lat_rad, relief_hi, rlonv, rlatu, phis, relief, &      CALL grid_noro(lon_rad, lat_rad, relief_hi, rlonv, rlatu, phis, relief, &
99           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)
100        deallocate(relief_hi) ! pointer
101    
102      phis(iim + 1, :) = phis(1, :)      phis(iim + 1, :) = phis(1, :)
103      phis(:, :) = phis(:, :) * 9.81      phis(:, :) = phis(:, :) * 9.81
Legend:
Removed from v.39  
changed lines
  Added in v.68
  ViewVC Help
Powered by ViewVC 1.1.21