da_transform_vtoy_adj.inc
References to this file elsewhere.
1 subroutine da_transform_vtoy_adj(iter,cv_size, be, ep, cv, iv, vp, vv, xbx, y, &
2 grid, config_flags, jcdf_flag)
3
4 !-------------------------------------------------------------------------
5 ! Purpose: Does Adjoint of control variable (V) transform to Obs-space(Y)
6 !-------------------------------------------------------------------------
7
8 implicit none
9
10 integer, intent(in) :: iter
11 integer, intent(in) :: cv_size ! Size of cv array.
12 type(be_type), intent(in) :: be ! background error structure.
13 type(ep_type), intent(in) :: ep ! ensemble perturbation structure.
14 real, intent(out) :: cv(1:cv_size) ! control variables.
15 type(iv_type), intent(inout) :: iv ! innovation vector (o-b).
16 type(vp_type), intent(inout) :: vp ! Grdipt/level CV.
17 type(vp_type), intent(inout) :: vv ! Grdipt/EOF CV.
18 type(xbx_type), intent(in) :: xbx ! For header & non-grid arrays.
19 type(y_type), intent(inout) :: y ! y = H(x_inc).
20 type(domain), intent(inout) :: grid
21 type(grid_config_rec_type), intent(inout) :: config_flags
22 logical, intent(in) :: jcdf_flag ! additional flag to switch off JcDF, used to switch off JcDF in calculation of J.
23
24 type (xbx_type) :: xbx_tmp
25
26 integer :: nobwin,ndynopt
27 #ifdef DM_PARALLEL
28 integer :: wrf_done_unit
29 #endif
30
31 character(len=4) :: filnam
32
33 call da_trace_entry("da_transform_vtoy_adj")
34
35 if (var4d) then
36 ndynopt = grid%dyn_opt
37 grid%dyn_opt = DYN_EM_TL
38 call nl_set_dyn_opt (1 , DYN_EM_TL)
39
40 if (jcdfi_use .AND. jcdf_flag ) then
41 call da_med_initialdata_input(grid , config_flags, 'tldf')
42 grid%g_u_2 = - grid%g_u_2
43 grid%g_v_2 = - grid%g_v_2
44 grid%g_w_2 = - grid%g_w_2
45 grid%g_t_2 = - grid%g_t_2
46 grid%g_ph_2 = - grid%g_ph_2
47 grid%g_mu_2 = - grid%g_mu_2
48 grid%g_moist = - grid%g_moist
49 else
50 grid%g_u_2 = 0.0
51 grid%g_v_2 = 0.0
52 grid%g_w_2 = 0.0
53 grid%g_t_2 = 0.0
54 grid%g_ph_2 = 0.0
55 grid%g_mu_2 = 0.0
56 grid%g_moist = 0.0
57 end if
58
59 call med_hist_out(grid , 3 , config_flags)
60
61 grid%dyn_opt = ndynopt
62 call nl_set_dyn_opt (1 , DYN_EM)
63
64 do nobwin=num_fgat_time,1,-1
65 write(unit=filnam, fmt='(a, i2.2)') 'fg', nobwin
66 call da_med_initialdata_input( grid , config_flags, &
67 filnam)
68 call da_setup_firstguess( xbx_tmp, grid)
69
70 iv%time = nobwin
71 iv%info(:)%n1 = iv%info(:)%plocal(iv%time-1) + 1
72 iv%info(:)%n2 = iv%info(:)%plocal(iv%time)
73 call da_zero_x(grid%xa)
74 call da_transform_xtoy_adj(grid, iv, y, grid%xa)
75 write(unit=filnam,fmt='(a2,i2.2)') 'af',nobwin
76
77 call da_transfer_wrftltoxa_adj(grid, config_flags, filnam)
78 end do
79
80 call da_trace("da_transform_vtoy_adj","Starting da_run_wrfplus_ad.ksh")
81
82 #ifdef DM_PARALLEL
83 if (var4d_coupling == var4d_coupling_disk_simul) then
84
85 if (rootproc) then
86 call da_system("da_run_wrfplus_ad.ksh pre")
87 call da_system("rm -rf wrf_done")
88 call da_system("touch wrf_go_ahead")
89 call da_get_unit(wrf_done_unit)
90 do while (.true.)
91 open(wrf_done_unit,file="wrf_done",status="old",err=303)
92 close(wrf_done_unit)
93 exit
94 303 continue
95 call da_system("sleep 1")
96 end do
97 call da_free_unit(wrf_done_unit)
98 call da_system("da_run_wrfplus_ad.ksh post")
99 end if
100 ! Wait until PE 0 agrees that AD finished
101 call wrf_get_dm_communicator ( comm )
102 call mpi_barrier(comm, ierr)
103 end if
104 #else
105 call da_system("da_run_wrfplus_ad.ksh")
106 #endif
107 call da_trace("da_transform_vtoy_adj","Finished da_run_wrfplus_ad.ksh")
108
109 call da_transfer_xatowrftl_adj(grid, config_flags, 'gr01')
110
111 if (num_fgat_time > 1) then ! Recover the firstguess fields touched by reading gr01
112 call da_med_initialdata_input( grid , config_flags, 'fg01')
113 end if
114
115 else ! var4d
116 iv%time = 1
117 iv%info(:)%n1 = iv%info(:)%plocal(iv%time-1) + 1
118 iv%info(:)%n2 = iv%info(:)%plocal(iv%time)
119 call da_zero_x(grid%xa)
120 call da_transform_xtoy_adj(grid, iv, y,grid%xa)
121 end if ! var4d
122
123 cv = 0.0
124 call da_transform_vtox_adj(grid, cv_size, xbx, be, ep, vp, vv, cv)
125
126 call da_trace_exit("da_transform_vtoy_adj")
127
128 end subroutine da_transform_vtoy_adj
129
130