dyn3d/Guide/conf_guide.f

module conf_guide_m

  USE dimens_m, ONLY: iim, jjm

  IMPLICIT NONE

  LOGICAL:: ini_anal = .false. ! Initial = analyse
  LOGICAL:: guide_u = .false. ! guidage de u
  LOGICAL:: guide_v = .false. ! gvidage de v
  LOGICAL:: guide_t = .false. ! guidage de T
  LOGICAL:: guide_q = .false. ! guidage de q

  logical, save:: ok_guide ! guidage

  ! alpha détermine la part des injections de données à chaque étape
  ! alpha=0 signifie pas d'injection
  ! alpha=1 signifie injection totale
  REAL, save:: alpha_q(iim + 1, jjm + 1)
  REAL, save:: alpha_t(iim + 1, jjm + 1)
  REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)

  private iim, jjm

contains

  SUBROUTINE conf_guide

    ! From LMDZ4/libf/dyn3d/conf_guide.F, version 1.1.1.1 2004/05/19 12:53:07
    !  Parametres de controle du run:

    use comconst, only: daysec, dtvr
    use conf_gcm_m, only: day_step, iperiod
    use dynetat0_m, only: grossismx, grossismy, rlatu, rlatv
    use init_tau2alpha_m, only: init_tau2alpha
    use nr_util, only: assert, pi
    use tau2alpha_m, only: tau2alpha
    use unit_nml_m, only: unit_nml
    use writefield_m, only: writefield

    ! Local:

    ! Constantes de rappel, en jours :
    REAL tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t
    real tau_min_q, tau_max_q

    REAL lat_min_guide_deg, lat_max_guide_deg ! in degrees

    ! Dans le cas où on n'a les analyses que sur une bande de latitudes :
    REAL lat_min_guide ! minimum latitude for nudging, in rad
    real lat_max_guide ! maximum latitude for nudging, in rad

    REAL factt ! pas de temps entre deux appels au guidage, en jours
    REAL dxdys(iim + 1, jjm + 1), dxdyu(iim + 1, jjm + 1), dxdyv(iim + 1, jjm)
    integer i, j

    namelist /conf_guide_nml/ ini_anal, guide_u, guide_v, guide_t, guide_q, &
         tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t, &
         tau_min_q, tau_max_q, lat_min_guide_deg, lat_max_guide_deg

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

    print *, "Call sequence information: conf_guide"

    ! Default values:
    tau_min_u = 0.03
    tau_max_u = 10.
    tau_min_v = 0.03
    tau_max_v = 10.
    tau_min_t = 0.03
    tau_max_t = 10.
    tau_min_q = 0.03
    tau_max_q = 10.
    lat_min_guide_deg = -90.
    lat_max_guide_deg = 90.

    print *, "Enter namelist 'conf_guide_nml'."
    read(unit=*, nml=conf_guide_nml)
    write(unit_nml, nml=conf_guide_nml)

    ok_guide = any((/guide_u, guide_v, guide_t, guide_q/))

    if (ok_guide) then
       call assert(mod(day_step, 4 * iperiod) == 0, &
            "conf_guide ok_guide day_step iperiod")
       lat_min_guide = lat_min_guide_deg / 180. * pi
       lat_max_guide = lat_max_guide_deg / 180. * pi
       factt = dtvr * iperiod / daysec
       print *, "factt = ", factt

       IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
          ! grille regulière
          if (guide_u) alpha_u = 1. - exp(- factt / tau_max_u)
          if (guide_v) alpha_v = 1. - exp(- factt / tau_max_v)
          if (guide_t) alpha_t = 1. - exp(- factt / tau_max_t)
          if (guide_q) alpha_q = 1. - exp(- factt / tau_max_q)
       else
          call init_tau2alpha(dxdys)

          if (guide_u) then
             DO j = 1, jjm + 1
                DO i = 1, iim
                   dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
                END DO
                dxdyu(iim + 1, j) = dxdyu(1, j)
             END DO

             CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyu, rlatu, &
                  tau_min_u, tau_max_u, alpha_u)
             CALL writefield("alpha_u", alpha_u)
          end if

          if (guide_v) then
             DO j = 1, jjm
                DO i = 1, iim + 1
                   dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
                END DO
             END DO

             CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyv, rlatv, &
                  tau_min_v, tau_max_v, alpha_v)
             CALL writefield("alpha_v", alpha_v)
          end if

          if (guide_t) then
             CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
                  tau_min_t, tau_max_t, alpha_t)
             CALL writefield("alpha_t", alpha_t)
          end if

          if (guide_q)  then
             CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
                  tau_min_q, tau_max_q, alpha_q)
             CALL writefield("alpha_q", alpha_q)
          end if
       end IF
    end if

  end SUBROUTINE conf_guide

end module conf_guide_m
1	guez	44	module conf_guide_m
2	guez	37
3	guez	211	USE dimens_m, ONLY: iim, jjm
4
5	guez	44	IMPLICIT NONE
6	guez	3
7	guez	83	LOGICAL:: ini_anal = .false. ! Initial = analyse
8	guez	115	LOGICAL:: guide_u = .false. ! guidage de u
9			LOGICAL:: guide_v = .false. ! gvidage de v
10	guez	107	LOGICAL:: guide_t = .false. ! guidage de T
11			LOGICAL:: guide_q = .false. ! guidage de q
12	guez	83
13	guez	211	logical, save:: ok_guide ! guidage
14	guez	102
15	guez	211	! alpha détermine la part des injections de données à chaque étape
16			! alpha=0 signifie pas d'injection
17			! alpha=1 signifie injection totale
18			REAL, save:: alpha_q(iim + 1, jjm + 1)
19			REAL, save:: alpha_t(iim + 1, jjm + 1)
20			REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm)
21	guez	83
22	guez	211	private iim, jjm
23	guez	115
24	guez	44	contains
25	guez	3
26	guez	44	SUBROUTINE conf_guide
27	guez	3
28	guez	44	! From LMDZ4/libf/dyn3d/conf_guide.F, version 1.1.1.1 2004/05/19 12:53:07
29			! Parametres de controle du run:
30	guez	3
31	guez	115	use comconst, only: daysec, dtvr
32			use conf_gcm_m, only: day_step, iperiod
33	guez	211	use dynetat0_m, only: grossismx, grossismy, rlatu, rlatv
34			use init_tau2alpha_m, only: init_tau2alpha
35	guez	140	use nr_util, only: assert, pi
36	guez	211	use tau2alpha_m, only: tau2alpha
37	guez	83	use unit_nml_m, only: unit_nml
38	guez	211	use writefield_m, only: writefield
39	guez	3
40	guez	140	! Local:
41
42	guez	211	! Constantes de rappel, en jours :
43			REAL tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t
44			real tau_min_q, tau_max_q
45	guez	140
46	guez	211	REAL lat_min_guide_deg, lat_max_guide_deg ! in degrees
47
48			! Dans le cas où on n'a les analyses que sur une bande de latitudes :
49			REAL lat_min_guide ! minimum latitude for nudging, in rad
50			real lat_max_guide ! maximum latitude for nudging, in rad
51
52			REAL factt ! pas de temps entre deux appels au guidage, en jours
53			REAL dxdys(iim + 1, jjm + 1), dxdyu(iim + 1, jjm + 1), dxdyv(iim + 1, jjm)
54			integer i, j
55
56	guez	173	namelist /conf_guide_nml/ ini_anal, guide_u, guide_v, guide_t, guide_q, &
57	guez	211	tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t, &
58			tau_min_q, tau_max_q, lat_min_guide_deg, lat_max_guide_deg
59	guez	83
60	guez	44	!-----------------------------------------------------------------------
61	guez	3
62	guez	44	print *, "Call sequence information: conf_guide"
63	guez	3
64	guez	211	! Default values:
65			tau_min_u = 0.03
66			tau_max_u = 10.
67			tau_min_v = 0.03
68			tau_max_v = 10.
69			tau_min_t = 0.03
70			tau_max_t = 10.
71			tau_min_q = 0.03
72			tau_max_q = 10.
73			lat_min_guide_deg = -90.
74			lat_max_guide_deg = 90.
75
76	guez	83	print *, "Enter namelist 'conf_guide_nml'."
77			read(unit=*, nml=conf_guide_nml)
78			write(unit_nml, nml=conf_guide_nml)
79	guez	3
80	guez	115	ok_guide = any((/guide_u, guide_v, guide_t, guide_q/))
81
82	guez	211	if (ok_guide) then
83			call assert(mod(day_step, 4 * iperiod) == 0, &
84			"conf_guide ok_guide day_step iperiod")
85			lat_min_guide = lat_min_guide_deg / 180. * pi
86			lat_max_guide = lat_max_guide_deg / 180. * pi
87	guez	115	factt = dtvr * iperiod / daysec
88			print *, "factt = ", factt
89	guez	211
90			IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
91			! grille regulière
92			if (guide_u) alpha_u = 1. - exp(- factt / tau_max_u)
93			if (guide_v) alpha_v = 1. - exp(- factt / tau_max_v)
94			if (guide_t) alpha_t = 1. - exp(- factt / tau_max_t)
95			if (guide_q) alpha_q = 1. - exp(- factt / tau_max_q)
96			else
97			call init_tau2alpha(dxdys)
98
99			if (guide_u) then
100			DO j = 1, jjm + 1
101			DO i = 1, iim
102			dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
103			END DO
104			dxdyu(iim + 1, j) = dxdyu(1, j)
105			END DO
106
107			CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyu, rlatu, &
108			tau_min_u, tau_max_u, alpha_u)
109			CALL writefield("alpha_u", alpha_u)
110			end if
111
112			if (guide_v) then
113			DO j = 1, jjm
114			DO i = 1, iim + 1
115			dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
116			END DO
117			END DO
118
119			CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyv, rlatv, &
120			tau_min_v, tau_max_v, alpha_v)
121			CALL writefield("alpha_v", alpha_v)
122			end if
123
124			if (guide_t) then
125			CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
126			tau_min_t, tau_max_t, alpha_t)
127			CALL writefield("alpha_t", alpha_t)
128			end if
129
130			if (guide_q) then
131			CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
132			tau_min_q, tau_max_q, alpha_q)
133			CALL writefield("alpha_q", alpha_q)
134			end if
135			end IF
136	guez	115	end if
137
138	guez	44	end SUBROUTINE conf_guide
139
140			end module conf_guide_m