pkg/ctrl/ctrl_map_forcing.F


#include "CTRL_CPPOPTIONS.h"

      SUBROUTINE CTRL_MAP_FORCING(myThid)
C     /==========================================================\
C     | SUBROUTINE CTRL_MAP_FORCING                              |
C     |==========================================================|
C     \==========================================================/
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "FFIELDS.h"
#include "GRID.h"

#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"

C     == Routine arguments ==
C     myThid - Thread number for this instance of the routine.
      INTEGER myThid

C     == Local variables ==
      integer bi,bj
      integer i,j,k
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
      integer il

      logical equal
      logical doglobalread
      logical ladinit

      character*( 80)   fnametauu
      character*( 80)   fnametauv
      character*( 80)   fnamesflux
      character*( 80)   fnamehflux
      character*( 80)   fnamesss
      character*( 80)   fnamesst
      character*( 80)   fnamediffkr
      character*( 80)   fnamekapgm

c     == external ==

      integer  ilnblnk
      external ilnblnk

c     == end of interface ==

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid)
      ithi = mybxhi(mythid)
      jmin = 1-oly
      jmax = sny+oly
      imin = 1-olx
      imax = snx+olx

      doglobalread = .false.
      ladinit      = .false.

#ifdef ALLOW_TAUU0_CONTROL
c--   tauu0.
      il=ilnblnk( xx_tauu_file )
      write(fnametauu(1:80),'(2a,i10.10)')
     &     xx_tauu_file(1:il),'.',optimcycle
      call active_read_xy ( fnametauu, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_tauu_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_TAUV0_CONTROL
c--   tauv0.
      il=ilnblnk( xx_tauv_file )
      write(fnametauv(1:80),'(2a,i10.10)')
     &     xx_tauv_file(1:il),'.',optimcycle
      call active_read_xy ( fnametauv, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_tauv_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SFLUX0_CONTROL
c--   sflux0.
      il=ilnblnk( xx_sflux_file )
      write(fnamesflux(1:80),'(2a,i10.10)')
     &     xx_sflux_file(1:il),'.',optimcycle
      call active_read_xy ( fnamesflux, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_sflux_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_HFLUX0_CONTROL
c--   hflux0.
      il=ilnblnk( xx_hflux_file )
      write(fnamehflux(1:80),'(2a,i10.10)')
     &     xx_hflux_file(1:il),'.',optimcycle
      call active_read_xy ( fnamehflux, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_hflux_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SSS0_CONTROL
c--   sss0.
      il=ilnblnk( xx_sss_file )
      write(fnamesss(1:80),'(2a,i10.10)')
     &     xx_sss_file(1:il),'.',optimcycle
      call active_read_xy ( fnamesss, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_sss_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SST0_CONTROL
c--   sst0.
      il=ilnblnk( xx_sst_file )
      write(fnamesst(1:80),'(2a,i10.10)')
     &     xx_sst_file(1:il),'.',optimcycle
      call active_read_xy ( fnamesst, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_sst_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_DIFFKR_CONTROL
c--   diffkr.
      il=ilnblnk( xx_diffkr_file )
      write(fnamediffkr(1:80),'(2a,i10.10)')
     &     xx_diffkr_file(1:il),'.',optimcycle
      call active_read_xyz( fnamediffkr, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_diffkr_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
     &                                tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif

#ifdef ALLOW_KAPGM_CONTROL
c--   kapgm.
      il=ilnblnk( xx_kapgm_file )
      write(fnamekapgm(1:80),'(2a,i10.10)')
     &     xx_kapgm_file(1:il),'.',optimcycle
      call active_read_xyz( fnamekapgm, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_kapgm_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
     &                               tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif

      END
1	heimbach	1.1
2			#include "CTRL_CPPOPTIONS.h"
3
4			SUBROUTINE CTRL_MAP_FORCING(myThid)
5			C /==========================================================\
6			C \| SUBROUTINE CTRL_MAP_FORCING \|
7			C \|==========================================================\|
8			C \==========================================================/
9			IMPLICIT NONE
10
11			C == Global variables ===
12			#include "SIZE.h"
13			#include "EEPARAMS.h"
14			#include "PARAMS.h"
15			#include "FFIELDS.h"
16			#include "GRID.h"
17
18			#include "ctrl.h"
19			#include "ctrl_dummy.h"
20	heimbach	1.2	#include "optim.h"
21	heimbach	1.1
22			C == Routine arguments ==
23			C myThid - Thread number for this instance of the routine.
24			INTEGER myThid
25
26			C == Local variables ==
27			integer bi,bj
28			integer i,j,k
29			integer itlo,ithi
30			integer jtlo,jthi
31			integer jmin,jmax
32			integer imin,imax
33			integer il
34
35			logical equal
36			logical doglobalread
37			logical ladinit
38
39			character*( 80) fnametauu
40			character*( 80) fnametauv
41			character*( 80) fnamesflux
42			character*( 80) fnamehflux
43			character*( 80) fnamesss
44			character*( 80) fnamesst
45			character*( 80) fnamediffkr
46			character*( 80) fnamekapgm
47
48			c == external ==
49
50			integer ilnblnk
51			external ilnblnk
52
53			c == end of interface ==
54
55			jtlo = mybylo(mythid)
56			jthi = mybyhi(mythid)
57			itlo = mybxlo(mythid)
58			ithi = mybxhi(mythid)
59			jmin = 1-oly
60			jmax = sny+oly
61			imin = 1-olx
62			imax = snx+olx
63
64			doglobalread = .false.
65			ladinit = .false.
66
67			#ifdef ALLOW_TAUU0_CONTROL
68			c-- tauu0.
69			il=ilnblnk( xx_tauu_file )
70			write(fnametauu(1:80),'(2a,i10.10)')
71			& xx_tauu_file(1:il),'.',optimcycle
72			call active_read_xy ( fnametauu, tmpfld2d, 1,
73			& doglobalread, ladinit, optimcycle,
74			& mythid, xx_tauu_dummy )
75			do bj = jtlo,jthi
76			do bi = itlo,ithi
77			do j = jmin,jmax
78			do i = imin,imax
79			fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
80			enddo
81			enddo
82			enddo
83			enddo
84			#endif
85
86			#ifdef ALLOW_TAUV0_CONTROL
87			c-- tauv0.
88			il=ilnblnk( xx_tauv_file )
89			write(fnametauv(1:80),'(2a,i10.10)')
90			& xx_tauv_file(1:il),'.',optimcycle
91			call active_read_xy ( fnametauv, tmpfld2d, 1,
92			& doglobalread, ladinit, optimcycle,
93			& mythid, xx_tauv_dummy )
94			do bj = jtlo,jthi
95			do bi = itlo,ithi
96			do j = jmin,jmax
97			do i = imin,imax
98			fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
99			enddo
100			enddo
101			enddo
102			enddo
103			#endif
104
105			#ifdef ALLOW_SFLUX0_CONTROL
106			c-- sflux0.
107			il=ilnblnk( xx_sflux_file )
108			write(fnamesflux(1:80),'(2a,i10.10)')
109			& xx_sflux_file(1:il),'.',optimcycle
110			call active_read_xy ( fnamesflux, tmpfld2d, 1,
111			& doglobalread, ladinit, optimcycle,
112			& mythid, xx_sflux_dummy )
113			do bj = jtlo,jthi
114			do bi = itlo,ithi
115			do j = jmin,jmax
116			do i = imin,imax
117			empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
118			enddo
119			enddo
120			enddo
121			enddo
122			#endif
123
124			#ifdef ALLOW_HFLUX0_CONTROL
125			c-- hflux0.
126			il=ilnblnk( xx_hflux_file )
127			write(fnamehflux(1:80),'(2a,i10.10)')
128			& xx_hflux_file(1:il),'.',optimcycle
129			call active_read_xy ( fnamehflux, tmpfld2d, 1,
130			& doglobalread, ladinit, optimcycle,
131			& mythid, xx_hflux_dummy )
132			do bj = jtlo,jthi
133			do bi = itlo,ithi
134			do j = jmin,jmax
135			do i = imin,imax
136			qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
137			enddo
138			enddo
139			enddo
140			enddo
141			#endif
142
143			#ifdef ALLOW_SSS0_CONTROL
144			c-- sss0.
145			il=ilnblnk( xx_sss_file )
146			write(fnamesss(1:80),'(2a,i10.10)')
147			& xx_sss_file(1:il),'.',optimcycle
148			call active_read_xy ( fnamesss, tmpfld2d, 1,
149			& doglobalread, ladinit, optimcycle,
150			& mythid, xx_sss_dummy )
151			do bj = jtlo,jthi
152			do bi = itlo,ithi
153			do j = jmin,jmax
154			do i = imin,imax
155			sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
156			enddo
157			enddo
158			enddo
159			enddo
160			#endif
161
162			#ifdef ALLOW_SST0_CONTROL
163			c-- sst0.
164			il=ilnblnk( xx_sst_file )
165			write(fnamesst(1:80),'(2a,i10.10)')
166			& xx_sst_file(1:il),'.',optimcycle
167			call active_read_xy ( fnamesst, tmpfld2d, 1,
168			& doglobalread, ladinit, optimcycle,
169			& mythid, xx_sst_dummy )
170			do bj = jtlo,jthi
171			do bi = itlo,ithi
172			do j = jmin,jmax
173			do i = imin,imax
174			sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
175			enddo
176			enddo
177			enddo
178			enddo
179			#endif
180
181			#ifdef ALLOW_DIFFKR_CONTROL
182			c-- diffkr.
183			il=ilnblnk( xx_diffkr_file )
184			write(fnamediffkr(1:80),'(2a,i10.10)')
185			& xx_diffkr_file(1:il),'.',optimcycle
186			call active_read_xyz( fnamediffkr, tmpfld3d, 1,
187			& doglobalread, ladinit, optimcycle,
188			& mythid, xx_diffkr_dummy )
189			do bj = jtlo,jthi
190			do bi = itlo,ithi
191			do k = 1,nr
192			do j = jmin,jmax
193			do i = imin,imax
194			diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
195			& tmpfld3d(i,j,k,bi,bj)
196			enddo
197			enddo
198			enddo
199			enddo
200			enddo
201			#endif
202
203			#ifdef ALLOW_KAPGM_CONTROL
204			c-- kapgm.
205			il=ilnblnk( xx_kapgm_file )
206			write(fnamekapgm(1:80),'(2a,i10.10)')
207			& xx_kapgm_file(1:il),'.',optimcycle
208			call active_read_xyz( fnamekapgm, tmpfld3d, 1,
209			& doglobalread, ladinit, optimcycle,
210			& mythid, xx_kapgm_dummy )
211			do bj = jtlo,jthi
212			do bi = itlo,ithi
213			do k = 1,nr
214			do j = jmin,jmax
215			do i = imin,imax
216			kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
217			& tmpfld3d(i,j,k,bi,bj)
218			enddo
219			enddo
220			enddo
221			enddo
222			enddo
223			#endif
224
225			END