phylmd/Orography/start_init_orog.f

MODULE start_init_orog_m

  ! From startvar.F, version 1.4
  ! 2006/01/27 15:14:22 Fairhead

  use dimens_m, only: iim, jjm

  IMPLICIT NONE

  REAL, SAVE:: mask(iim + 1, jjm + 1) ! interpolated fraction of land

  private iim, jjm

CONTAINS

  SUBROUTINE start_init_orog(phis, zmea_2d, zstd_2d, zsig_2d, zgam_2d, &
       zthe_2d, zpic_2d, zval_2d)

    use conf_dat2d_m, only: conf_dat2d
    use comgeom, only: rlatu, rlonv
    use grid_noro_m, only: grid_noro
    use indicesol, only: epsfra
    use netcdf, only: nf90_nowrite
    use netcdf95, only: nf95_open, nf95_gw_var, nf95_inq_varid, nf95_close
    use nr_util, only: pi, assert

    REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)
    ! surface geopotential, in m2 s-2

    REAL, intent(out):: zmea_2d(:, :) ! (iim + 1, jjm + 1) orographie moyenne

    REAL, intent(out):: zstd_2d(:, :) ! (iim + 1, jjm + 1)
    ! (deviation standard de l'orographie sous-maille)

    REAL, intent(out):: zsig_2d(:, :) ! (iim + 1, jjm + 1)
    ! (pente de l'orographie sous-maille)
    
    REAL, intent(out):: zgam_2d(:, :) ! (iim + 1, jjm + 1)
    ! (anisotropie de l'orographie sous maille)

    REAL, intent(out):: zthe_2d(:, :) ! (iim + 1, jjm + 1)
    ! (orientation de l'axe oriente dans la direction de plus grande
    ! pente de l'orographie sous maille)

    REAL, intent(out):: zpic_2d(:, :) ! (iim + 1, jjm + 1)
    ! hauteur pics de la SSO

    REAL, intent(out):: zval_2d(:, :) ! (iim + 1, jjm + 1)
    ! hauteur vallees de la SSO

    ! Local:

    INTEGER iml_rel
    INTEGER jml_rel
    INTEGER ncid, varid
    REAL, pointer:: relief(:, :)
    REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
    REAL, pointer:: lon_ini(:), lat_ini(:)

    !-----------------------------------

    print *, "Call sequence information: start_init_orog"

    call assert((/size(phis, 1), size(zmea_2d, 1), size(zstd_2d, 1), &
         size(zsig_2d, 1), size(zgam_2d, 1), size(zthe_2d, 1), &
         size(zpic_2d, 1), size(zval_2d, 1)/) == iim + 1, "start_init_orog iim")
    call assert((/size(phis, 2), size(zmea_2d, 2), size(zstd_2d, 2), &
         size(zsig_2d, 2), size(zgam_2d, 2), size(zthe_2d, 2), &
         size(zpic_2d, 2), size(zval_2d, 2)/) == jjm + 1, "start_init_orog jjm")

    print *, 'Reading the high resolution orography...'

    call nf95_open('Relief.nc', nf90_nowrite, ncid)

    call nf95_inq_varid(ncid, "longitude", varid)
    call nf95_gw_var(ncid, varid, lon_ini)
    lon_ini = lon_ini * pi / 180. ! convert to rad
    iml_rel = size(lon_ini)

    call nf95_inq_varid(ncid, "latitude", varid)
    call nf95_gw_var(ncid, varid, lat_ini)
    lat_ini = lat_ini * pi / 180. ! convert to rad
    jml_rel = size(lat_ini)

    call nf95_inq_varid(ncid, "RELIEF", varid)
    call nf95_gw_var(ncid, varid, relief)

    call nf95_close(ncid)

    ALLOCATE(lon_rad(iml_rel))
    ALLOCATE(lat_rad(jml_rel))

    CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, relief , &
         interbar=.FALSE.)
    deallocate(lon_ini, lat_ini) ! pointers

    print *, 'Compute all the parameters needed for the gravity wave drag code'

    CALL grid_noro(lon_rad, lat_rad, relief, rlonv, rlatu, phis, zmea_2d, &
         zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, zval_2d, mask)
    deallocate(relief) ! pointer
    phis(:, :) = phis(:, :) * 9.81

    mask(2:, 1) = mask(1, 1) ! north pole
    mask(2:, jjm + 1) = mask(1, jjm + 1) ! south pole
    mask(iim + 1, 2:jjm) = mask(1, 2:jjm) ! Greenwich
    WHERE (mask < EPSFRA)
       mask = 0.
    elsewhere (1. - mask < EPSFRA)
       mask = 1.
    endwhere

  END SUBROUTINE start_init_orog

END MODULE start_init_orog_m
1	guez	3	MODULE start_init_orog_m
2
3			! From startvar.F, version 1.4
4			! 2006/01/27 15:14:22 Fairhead
5
6	guez	78	use dimens_m, only: iim, jjm
7
8	guez	3	IMPLICIT NONE
9
10	guez	78	REAL, SAVE:: mask(iim + 1, jjm + 1) ! interpolated fraction of land
11	guez	3
12	guez	78	private iim, jjm
13
14	guez	3	CONTAINS
15
16	guez	78	SUBROUTINE start_init_orog(phis, zmea_2d, zstd_2d, zsig_2d, zgam_2d, &
17			zthe_2d, zpic_2d, zval_2d)
18	guez	3
19			use conf_dat2d_m, only: conf_dat2d
20			use comgeom, only: rlatu, rlonv
21	guez	39	use grid_noro_m, only: grid_noro
22	guez	3	use indicesol, only: epsfra
23	guez	43	use netcdf, only: nf90_nowrite
24			use netcdf95, only: nf95_open, nf95_gw_var, nf95_inq_varid, nf95_close
25	guez	78	use nr_util, only: pi, assert
26	guez	3
27	guez	78	REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)
28			! surface geopotential, in m2 s-2
29	guez	3
30	guez	78	REAL, intent(out):: zmea_2d(:, :) ! (iim + 1, jjm + 1) orographie moyenne
31
32	guez	42	REAL, intent(out):: zstd_2d(:, :) ! (iim + 1, jjm + 1)
33	guez	3	! (deviation standard de l'orographie sous-maille)
34
35	guez	42	REAL, intent(out):: zsig_2d(:, :) ! (iim + 1, jjm + 1)
36	guez	3	! (pente de l'orographie sous-maille)
37
38	guez	42	REAL, intent(out):: zgam_2d(:, :) ! (iim + 1, jjm + 1)
39	guez	3	! (anisotropie de l'orographie sous maille)
40
41	guez	42	REAL, intent(out):: zthe_2d(:, :) ! (iim + 1, jjm + 1)
42	guez	3	! (orientation de l'axe oriente dans la direction de plus grande
43			! pente de l'orographie sous maille)
44
45	guez	42	REAL, intent(out):: zpic_2d(:, :) ! (iim + 1, jjm + 1)
46			! hauteur pics de la SSO
47	guez	3
48	guez	42	REAL, intent(out):: zval_2d(:, :) ! (iim + 1, jjm + 1)
49			! hauteur vallees de la SSO
50
51	guez	3	! Local:
52
53	guez	42	INTEGER iml_rel
54			INTEGER jml_rel
55	guez	43	INTEGER ncid, varid
56	guez	78	REAL, pointer:: relief(:, :)
57	guez	3	REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
58	guez	43	REAL, pointer:: lon_ini(:), lat_ini(:)
59	guez	3
60			!-----------------------------------
61
62			print *, "Call sequence information: start_init_orog"
63
64	guez	78	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	guez	3
71	guez	43	print *, 'Reading the high resolution orography...'
72	guez	3
73	guez	43	call nf95_open('Relief.nc', nf90_nowrite, ncid)
74	guez	3
75	guez	43	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	guez	3
80	guez	43	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	guez	3
85	guez	43	call nf95_inq_varid(ncid, "RELIEF", varid)
86	guez	78	call nf95_gw_var(ncid, varid, relief)
87	guez	3
88	guez	43	call nf95_close(ncid)
89	guez	3
90	guez	43	ALLOCATE(lon_rad(iml_rel))
91	guez	3	ALLOCATE(lat_rad(jml_rel))
92
93	guez	78	CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, relief , &
94	guez	3	interbar=.FALSE.)
95	guez	43	deallocate(lon_ini, lat_ini) ! pointers
96	guez	3
97			print *, 'Compute all the parameters needed for the gravity wave drag code'
98
99	guez	78	CALL grid_noro(lon_rad, lat_rad, relief, rlonv, rlatu, phis, zmea_2d, &
100	guez	15	zstd_2d, zsig_2d, zgam_2d, zthe_2d, zpic_2d, zval_2d, mask)
101	guez	78	deallocate(relief) ! pointer
102	guez	3	phis(:, :) = phis(:, :) * 9.81
103
104	guez	15	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	guez	3	endwhere
112
113			END SUBROUTINE start_init_orog
114
115			END MODULE start_init_orog_m