1 |
C $Header$ |
C $Header$ |
2 |
C $Name$ |
C $Name$ |
3 |
|
|
|
#include "PACKAGES_CONFIG.h" |
|
4 |
#include "CTRL_CPPOPTIONS.h" |
#include "CTRL_CPPOPTIONS.h" |
5 |
|
#include "AD_CONFIG.h" |
6 |
|
|
7 |
subroutine ctrl_pack( first, mythid ) |
subroutine ctrl_pack( first, mythid ) |
8 |
|
|
18 |
c changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000 |
c changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000 |
19 |
c - Transferred some filename declarations |
c - Transferred some filename declarations |
20 |
c from here to namelist in ctrl_init |
c from here to namelist in ctrl_init |
21 |
c |
c |
22 |
c Patrick Heimbach heimbach@mit.edu 16-Jun-2000 |
c Patrick Heimbach heimbach@mit.edu 16-Jun-2000 |
23 |
c - single file name convention with or without |
c - single file name convention with or without |
24 |
c ALLOW_ECCO_OPTIMIZATION |
c ALLOW_ECCO_OPTIMIZATION |
59 |
integer mythid |
integer mythid |
60 |
|
|
61 |
#ifndef EXCLUDE_CTRL_PACK |
#ifndef EXCLUDE_CTRL_PACK |
62 |
|
#if (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN)) |
63 |
c == local variables == |
c == local variables == |
64 |
|
|
65 |
_RL fcloc |
_RL fcloc |
76 |
logical ladinit |
logical ladinit |
77 |
integer cbuffindex |
integer cbuffindex |
78 |
logical lxxadxx |
logical lxxadxx |
79 |
|
|
80 |
integer cunit |
integer cunit |
81 |
integer ictrlgrad |
integer ictrlgrad |
82 |
|
|
152 |
cHFLUXM_CONTROL |
cHFLUXM_CONTROL |
153 |
call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid) |
call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid) |
154 |
cHFLUXM_CONTROL |
cHFLUXM_CONTROL |
155 |
|
call ctrl_set_fname(xx_shifwflx_file, fname_shifwflx, mythid) |
156 |
|
|
157 |
c-- Only the master thread will do I/O. |
c-- Only the master thread will do I/O. |
158 |
_BEGIN_MASTER( mythid ) |
_BEGIN_MASTER( mythid ) |
163 |
ictrlgrad = 1 |
ictrlgrad = 1 |
164 |
fcloc = fmin |
fcloc = fmin |
165 |
write(cfile(1:128),'(4a,i4.4)') |
write(cfile(1:128),'(4a,i4.4)') |
166 |
& ctrlname(1:9),'_',yctrlid(1:10), |
& ctrlname(1:9),'_',yctrlid(1:10), |
167 |
& yctrlpospack, optimcycle |
& yctrlpospack, optimcycle |
168 |
print *, 'ph-pack: packing ', ctrlname(1:9) |
print *, 'ph-pack: packing ', ctrlname(1:9) |
169 |
else |
else |
172 |
ictrlgrad = 2 |
ictrlgrad = 2 |
173 |
fcloc = fc |
fcloc = fc |
174 |
write(cfile(1:128),'(4a,i4.4)') |
write(cfile(1:128),'(4a,i4.4)') |
175 |
& costname(1:9),'_',yctrlid(1:10), |
& costname(1:9),'_',yctrlid(1:10), |
176 |
& yctrlpospack, optimcycle |
& yctrlpospack, optimcycle |
177 |
print *, 'ph-pack: packing ', costname(1:9) |
print *, 'ph-pack: packing ', costname(1:9) |
178 |
endif |
endif |
179 |
|
|
180 |
|
c-- Only Proc 0 will do I/O. |
181 |
|
IF ( myProcId .eq. 0 ) THEN |
182 |
|
|
183 |
call mdsfindunit( cunit, mythid ) |
call mdsfindunit( cunit, mythid ) |
184 |
open( cunit, file = cfile, |
open( cunit, file = cfile, |
185 |
& status = 'unknown', |
& status = 'unknown', |
204 |
#ifdef ALLOW_CTRL_WETV |
#ifdef ALLOW_CTRL_WETV |
205 |
write(cunit) (nWetvGlobal(k), k=1,nr) |
write(cunit) (nWetvGlobal(k), k=1,nr) |
206 |
#endif |
#endif |
207 |
|
#ifdef ALLOW_SHIFWFLX_CONTROL |
208 |
|
write(cunit) (nWetiGlobal(k), k=1,nr) |
209 |
|
c write(cunit) nWetiGlobal(1) |
210 |
|
#endif |
211 |
|
|
212 |
#ifdef ALLOW_OBCSN_CONTROL |
#ifdef ALLOW_OBCSN_CONTROL |
213 |
write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs) |
write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs) |
229 |
write(cunit) (ncvargrd(i), i=1,maxcvars) |
write(cunit) (ncvargrd(i), i=1,maxcvars) |
230 |
write(cunit) |
write(cunit) |
231 |
|
|
232 |
|
#ifdef ALLOW_PACKUNPACK_METHOD2 |
233 |
|
ENDIF |
234 |
|
_END_MASTER( mythid ) |
235 |
|
_BARRIER |
236 |
|
#endif |
237 |
|
|
238 |
#ifdef ALLOW_THETA0_CONTROL |
#ifdef ALLOW_THETA0_CONTROL |
239 |
ivartype = 1 |
ivartype = 1 |
240 |
write(weighttype(1:80),'(80a)') ' ' |
write(weighttype(1:80),'(80a)') ' ' |
481 |
write(weighttype(1:80),'(a)') "wuvel" |
write(weighttype(1:80),'(a)') "wuvel" |
482 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
483 |
& cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW", |
& cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW", |
484 |
& weighttype, wunit, lxxadxx, mythid) |
& weighttype, wuvel, lxxadxx, mythid) |
485 |
#endif |
#endif |
486 |
|
|
487 |
#ifdef ALLOW_VVEL0_CONTROL |
#ifdef ALLOW_VVEL0_CONTROL |
490 |
write(weighttype(1:80),'(a)') "wvvel" |
write(weighttype(1:80),'(a)') "wvvel" |
491 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
492 |
& cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS", |
& cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS", |
493 |
& weighttype, wunit, lxxadxx, mythid) |
& weighttype, wvvel, lxxadxx, mythid) |
494 |
#endif |
#endif |
495 |
|
|
496 |
#ifdef ALLOW_ETAN0_CONTROL |
#ifdef ALLOW_ETAN0_CONTROL |
629 |
#endif |
#endif |
630 |
|
|
631 |
#ifdef ALLOW_KAPREDI_CONTROL |
#ifdef ALLOW_KAPREDI_CONTROL |
632 |
ivartype = 44 |
ivartype = 44 |
633 |
write(weighttype(1:80),'(80a)') ' ' |
write(weighttype(1:80),'(80a)') ' ' |
634 |
write(weighttype(1:80),'(a)') "wkapredi" |
write(weighttype(1:80),'(a)') "wkapredi" |
635 |
call ctrl_set_pack_xyz( |
call ctrl_set_pack_xyz( |
637 |
& weighttype, wkapredi, lxxadxx, mythid) |
& weighttype, wkapredi, lxxadxx, mythid) |
638 |
#endif |
#endif |
639 |
|
|
640 |
close ( cunit ) |
#ifdef ALLOW_SHIFWFLX_CONTROL |
641 |
|
ivartype = 45 |
642 |
|
write(weighttype(1:80),'(80a)') ' ' |
643 |
|
write(weighttype(1:80),'(a)') "wshifwflx" |
644 |
|
call ctrl_set_pack_xy( |
645 |
|
& cunit, ivartype, fname_shifwflx(ictrlgrad), |
646 |
|
& "maskCtrlI", weighttype, lxxadxx, mythid) |
647 |
|
#endif |
648 |
|
|
649 |
_END_MASTER( mythid ) |
#ifdef ALLOW_PACKUNPACK_METHOD2 |
650 |
|
_BEGIN_MASTER( mythid ) |
651 |
|
IF ( myProcId .eq. 0 ) THEN |
652 |
|
#endif |
653 |
|
|
654 |
|
close ( cunit ) |
655 |
|
ENDIF !IF ( myProcId .eq. 0 ) |
656 |
|
_END_MASTER( mythid ) |
657 |
|
_BARRIER |
658 |
|
#endif /* (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN)) */ |
659 |
#endif /* EXCLUDE_CTRL_PACK */ |
#endif /* EXCLUDE_CTRL_PACK */ |
660 |
|
|
661 |
return |
return |
662 |
end |
end |
|
|
|