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 abort_gcm_m, only: abort_gcm
    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 abort_gcm_m, only: abort_gcm
32			use comconst, only: daysec, dtvr
33			use conf_gcm_m, only: day_step, iperiod
34	guez	211	use dynetat0_m, only: grossismx, grossismy, rlatu, rlatv
35			use init_tau2alpha_m, only: init_tau2alpha
36	guez	140	use nr_util, only: assert, pi
37	guez	211	use tau2alpha_m, only: tau2alpha
38	guez	83	use unit_nml_m, only: unit_nml
39	guez	211	use writefield_m, only: writefield
40	guez	3
41	guez	140	! Local:
42
43	guez	211	! Constantes de rappel, en jours :
44			REAL tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t
45			real tau_min_q, tau_max_q
46	guez	140
47	guez	211	REAL lat_min_guide_deg, lat_max_guide_deg ! in degrees
48
49			! Dans le cas où on n'a les analyses que sur une bande de latitudes :
50			REAL lat_min_guide ! minimum latitude for nudging, in rad
51			real lat_max_guide ! maximum latitude for nudging, in rad
52
53			REAL factt ! pas de temps entre deux appels au guidage, en jours
54			REAL dxdys(iim + 1, jjm + 1), dxdyu(iim + 1, jjm + 1), dxdyv(iim + 1, jjm)
55			integer i, j
56
57	guez	173	namelist /conf_guide_nml/ ini_anal, guide_u, guide_v, guide_t, guide_q, &
58	guez	211	tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, tau_max_t, &
59			tau_min_q, tau_max_q, lat_min_guide_deg, lat_max_guide_deg
60	guez	83
61	guez	44	!-----------------------------------------------------------------------
62	guez	3
63	guez	44	print *, "Call sequence information: conf_guide"
64	guez	3
65	guez	211	! Default values:
66			tau_min_u = 0.03
67			tau_max_u = 10.
68			tau_min_v = 0.03
69			tau_max_v = 10.
70			tau_min_t = 0.03
71			tau_max_t = 10.
72			tau_min_q = 0.03
73			tau_max_q = 10.
74			lat_min_guide_deg = -90.
75			lat_max_guide_deg = 90.
76
77	guez	83	print *, "Enter namelist 'conf_guide_nml'."
78			read(unit=*, nml=conf_guide_nml)
79			write(unit_nml, nml=conf_guide_nml)
80	guez	3
81	guez	115	ok_guide = any((/guide_u, guide_v, guide_t, guide_q/))
82
83	guez	211	if (ok_guide) then
84			call assert(mod(day_step, 4 * iperiod) == 0, &
85			"conf_guide ok_guide day_step iperiod")
86			lat_min_guide = lat_min_guide_deg / 180. * pi
87			lat_max_guide = lat_max_guide_deg / 180. * pi
88	guez	115	factt = dtvr * iperiod / daysec
89			print *, "factt = ", factt
90	guez	211
91			IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN
92			! grille regulière
93			if (guide_u) alpha_u = 1. - exp(- factt / tau_max_u)
94			if (guide_v) alpha_v = 1. - exp(- factt / tau_max_v)
95			if (guide_t) alpha_t = 1. - exp(- factt / tau_max_t)
96			if (guide_q) alpha_q = 1. - exp(- factt / tau_max_q)
97			else
98			call init_tau2alpha(dxdys)
99
100			if (guide_u) then
101			DO j = 1, jjm + 1
102			DO i = 1, iim
103			dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
104			END DO
105			dxdyu(iim + 1, j) = dxdyu(1, j)
106			END DO
107
108			CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyu, rlatu, &
109			tau_min_u, tau_max_u, alpha_u)
110			CALL writefield("alpha_u", alpha_u)
111			end if
112
113			if (guide_v) then
114			DO j = 1, jjm
115			DO i = 1, iim + 1
116			dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
117			END DO
118			END DO
119
120			CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdyv, rlatv, &
121			tau_min_v, tau_max_v, alpha_v)
122			CALL writefield("alpha_v", alpha_v)
123			end if
124
125			if (guide_t) then
126			CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
127			tau_min_t, tau_max_t, alpha_t)
128			CALL writefield("alpha_t", alpha_t)
129			end if
130
131			if (guide_q) then
132			CALL tau2alpha(lat_min_guide, lat_max_guide, factt, dxdys, rlatu, &
133			tau_min_q, tau_max_q, alpha_q)
134			CALL writefield("alpha_q", alpha_q)
135			end if
136			end IF
137	guez	115	end if
138
139	guez	44	end SUBROUTINE conf_guide
140
141			end module conf_guide_m