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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 134 - (show annotations)
Wed Apr 29 15:47:56 2015 UTC (9 years ago) by guez
Original Path: trunk/Sources/phylmd/Orography/start_init_orog_m.f
File size: 3623 byte(s)
Sources inside, compilation outside.
1 MODULE start_init_orog_m
2
3 ! From startvar.F, version 1.4
4 ! 2006/01/27 15:14:22 Fairhead
5
6 use dimens_m, only: iim, jjm
7
8 IMPLICIT NONE
9
10 REAL, SAVE:: mask(iim + 1, jjm + 1) ! interpolated fraction of land
11
12 private iim, jjm
13
14 CONTAINS
15
16 SUBROUTINE start_init_orog(phis, zmea_2d, zstd_2d, zsig_2d, zgam_2d, &
17 zthe_2d, zpic_2d, zval_2d)
18
19 use conf_dat2d_m, only: conf_dat2d
20 use comgeom, only: rlatu, rlonv
21 use grid_noro_m, only: grid_noro
22 use indicesol, only: epsfra
23 use netcdf, only: nf90_nowrite
24 use netcdf95, only: nf95_open, nf95_gw_var, nf95_inq_varid, nf95_close
25 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):: zmea_2d(:, :) ! (iim + 1, jjm + 1) orographie moyenne
31
32 REAL, intent(out):: zstd_2d(:, :) ! (iim + 1, jjm + 1)
33 ! (deviation standard de l'orographie sous-maille)
34
35 REAL, intent(out):: zsig_2d(:, :) ! (iim + 1, jjm + 1)
36 ! (pente de l'orographie sous-maille)
37
38 REAL, intent(out):: zgam_2d(:, :) ! (iim + 1, jjm + 1)
39 ! (anisotropie de l'orographie sous maille)
40
41 REAL, intent(out):: zthe_2d(:, :) ! (iim + 1, jjm + 1)
42 ! (orientation de l'axe oriente dans la direction de plus grande
43 ! pente de l'orographie sous maille)
44
45 REAL, intent(out):: zpic_2d(:, :) ! (iim + 1, jjm + 1)
46 ! hauteur pics de la SSO
47
48 REAL, intent(out):: zval_2d(:, :) ! (iim + 1, jjm + 1)
49 ! hauteur vallees de la SSO
50
51 ! Local:
52
53 INTEGER iml_rel
54 INTEGER jml_rel
55 INTEGER ncid, varid
56 REAL, pointer:: relief(:, :)
57 REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
58 REAL, pointer:: lon_ini(:), lat_ini(:)
59
60 !-----------------------------------
61
62 print *, "Call sequence information: start_init_orog"
63
64 call assert((/size(phis, 1), size(zmea_2d, 1), size(zstd_2d, 1), &
65 size(zsig_2d, 1), size(zgam_2d, 1), size(zthe_2d, 1), &
66 size(zpic_2d, 1), size(zval_2d, 1)/) == iim + 1, "start_init_orog iim")
67 call assert((/size(phis, 2), size(zmea_2d, 2), size(zstd_2d, 2), &
68 size(zsig_2d, 2), size(zgam_2d, 2), size(zthe_2d, 2), &
69 size(zpic_2d, 2), size(zval_2d, 2)/) == jjm + 1, "start_init_orog jjm")
70
71 print *, 'Reading the high resolution orography...'
72
73 call nf95_open('Relief.nc', nf90_nowrite, ncid)
74
75 call nf95_inq_varid(ncid, "longitude", varid)
76 call nf95_gw_var(ncid, varid, lon_ini)
77 lon_ini = lon_ini * pi / 180. ! convert to rad
78 iml_rel = size(lon_ini)
79
80 call nf95_inq_varid(ncid, "latitude", varid)
81 call nf95_gw_var(ncid, varid, lat_ini)
82 lat_ini = lat_ini * pi / 180. ! convert to rad
83 jml_rel = size(lat_ini)
84
85 call nf95_inq_varid(ncid, "RELIEF", varid)
86 call nf95_gw_var(ncid, varid, relief)
87
88 call nf95_close(ncid)
89
90 ALLOCATE(lon_rad(iml_rel))
91 ALLOCATE(lat_rad(jml_rel))
92
93 CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, relief , &
94 interbar=.FALSE.)
95 deallocate(lon_ini, lat_ini) ! pointers
96
97 print *, 'Compute all the parameters needed for the gravity wave drag code'
98
99 CALL grid_noro(lon_rad, lat_rad, relief, rlonv, rlatu, phis, zmea_2d, &
100 zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, zval_2d, mask)
101 deallocate(relief) ! pointer
102 phis(:, :) = phis(:, :) * 9.81
103
104 mask(2:, 1) = mask(1, 1) ! north pole
105 mask(2:, jjm + 1) = mask(1, jjm + 1) ! south pole
106 mask(iim + 1, 2:jjm) = mask(1, 2:jjm) ! Greenwich
107 WHERE (mask < EPSFRA)
108 mask = 0.
109 elsewhere (1. - mask < EPSFRA)
110 mask = 1.
111 endwhere
112
113 END SUBROUTINE start_init_orog
114
115 END MODULE start_init_orog_m

  ViewVC Help
Powered by ViewVC 1.1.21