pkg/dic/dic_set_control.F

C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_set_control.F,v 1.8 2013/11/08 19:30:37 jahn Exp $
C $Name:  $

#include "DIC_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif

cphc$taf COMMON DIC_XX        adname = addic_xx
cphc$taf COMMON DIC_COST_CTRL adname = ADDIC_COST_CTRL


C !INTERFACE: ==========================================================
      SUBROUTINE DIC_SET_CONTROL( myThid )

C !DESCRIPTION:

C !USES: ===============================================================
      IMPLICIT NONE

C     == GLobal variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#ifdef DIC_BIOTIC
# include "DIC_VARS.h"
# include "DIC_CTRL.h"
#endif
#ifdef ALLOW_CTRL
#include "CTRL_SIZE.h"
#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"
#endif
C     == Routine arguments ==
      INTEGER myThid

#ifdef ALLOW_CTRL
cph#ifdef DIC_BIOTIC
C     == Local arguments ==
      INTEGER bi, bj
      INTEGER i, j
      INTEGER il
      LOGICAL doglobalread
      LOGICAL ladinit
      LOGICAL equal
      CHARACTER*( 80)   fnamegen2d
      _RL fac
c     == external ==
      INTEGER  ILNBLNK
      EXTERNAL ILNBLNK

c     == end of interface ==
CEOP

      doglobalread = .FALSE.
      ladinit      = .FALSE.

      equal = .TRUE.

      IF ( equal ) THEN
        fac = 1. _d 0
      ELSE
        fac = 0. _d 0
      ENDIF

      print*,'QQ alpha before', alpha(20,10,1,1)

#ifdef ALLOW_GEN2D_CONTROL
      il=ILNBLNK( xx_gen2d_file )
      WRITE(fnamegen2d(1:80),'(2a,i10.10)')
     &     xx_gen2d_file(1:il),'.',optimcycle
      CALL ACTIVE_READ_XY( fnamegen2d, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      myThid, xx_gen2d_dummy )

      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
         DO j = 1, sNy
          DO i = 1, sNx
             alpha (i,j,bi,bj) = alpha(i,j,bi,bj)
     &                         + fac*tmpfld2d(i,j,bi,bj)
          ENDDO
         ENDDO
       ENDDO
      ENDDO
cswd -- QQ limits!
cph                IF (alpha(i,j,bi,bj).GT.alphamax) THEN
cph                   alpha(i,j,bi,bj)=alphamax
cph                ENDIF
cph                IF (alpha(i,j,bi,bj).LT.alphamin) THEN
cph                   alpha(i,j,bi,bj)=alphamin
cph                ENDIF
cswd -- QQ limits
      print*,'QQ - preturb alpha', alpha(20,10,1,1),
     &                             tmpfld2d(20,10,1,1)
#endif /* ALLOW_GEN2D_CONTROL */

#ifdef ALLOW_DIC_CONTROL

      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
         DO j = 1, sNy
          DO i = 1, sNx
            feload(i,j,bi,bj) = feload(i,j,bi,bj)*(1. _d 0 +xx_dic(1))
            rain_ratio(i,j,bi,bj) =
     &                      rain_ratio(i,j,bi,bj)*(1. _d 0 +xx_dic(2))
          ENDDO
         ENDDO
       ENDDO
      ENDDO

      _EXCH_XY_RL( alpha, myThid )
      _EXCH_XY_RL( rain_ratio, myThid )
      _EXCH_XY_RL( feload, myThid )

      KScav       = KScav       * ( 1. _d 0 + xx_dic(3)*1. _d 6 )
      ligand_stab = ligand_stab * ( 1. _d 0 + xx_dic(4)*1. _d 6 )
      ligand_tot  = ligand_tot  * ( 1. _d 0 + xx_dic(5)*1. _d 6 )

      print *,'COST KScav = ', KScav
      print *,'COST ligand_stab = ', ligand_stab
      print *,'COST ligand_tot = ', ligand_tot

#endif /* ALLOW_DIC_CONTROL */

#endif /* ALLOW_CTRL */

cph#endif /* DIC_BIOTIC */

      RETURN
      END
1	jmc	1.9	C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_set_control.F,v 1.8 2013/11/08 19:30:37 jahn Exp $
2	heimbach	1.1	C $Name: $
3
4			#include "DIC_OPTIONS.h"
5	jmc	1.9	#ifdef ALLOW_CTRL
6			# include "CTRL_OPTIONS.h"
7			#endif
8	heimbach	1.1
9	jmc	1.5	cphc$taf COMMON DIC_XX adname = addic_xx
10			cphc$taf COMMON DIC_COST_CTRL adname = ADDIC_COST_CTRL
11	heimbach	1.1
12
13			C !INTERFACE: ==========================================================
14	jmc	1.5	SUBROUTINE DIC_SET_CONTROL( myThid )
15	heimbach	1.1
16			C !DESCRIPTION:
17
18			C !USES: ===============================================================
19	jmc	1.5	IMPLICIT NONE
20	heimbach	1.1
21			C == GLobal variables ==
22			#include "SIZE.h"
23			#include "EEPARAMS.h"
24			#include "PARAMS.h"
25			#ifdef DIC_BIOTIC
26			# include "DIC_VARS.h"
27			# include "DIC_CTRL.h"
28			#endif
29	heimbach	1.2	#ifdef ALLOW_CTRL
30	jmc	1.7	#include "CTRL_SIZE.h"
31	heimbach	1.1	#include "ctrl.h"
32			#include "ctrl_dummy.h"
33			#include "optim.h"
34	heimbach	1.2	#endif
35	heimbach	1.1	C == Routine arguments ==
36			INTEGER myThid
37
38	jmc	1.6	#ifdef ALLOW_CTRL
39	heimbach	1.1	cph#ifdef DIC_BIOTIC
40			C == Local arguments ==
41			INTEGER bi, bj
42			INTEGER i, j
43	jmc	1.5	INTEGER il
44			LOGICAL doglobalread
45			LOGICAL ladinit
46			LOGICAL equal
47			CHARACTER*( 80) fnamegen2d
48			_RL fac
49	heimbach	1.1	c == external ==
50	jmc	1.5	INTEGER ILNBLNK
51			EXTERNAL ILNBLNK
52	heimbach	1.1
53			c == end of interface ==
54			CEOP
55
56	jmc	1.5	doglobalread = .FALSE.
57			ladinit = .FALSE.
58	heimbach	1.1
59	jmc	1.5	equal = .TRUE.
60	heimbach	1.1
61	jmc	1.5	IF ( equal ) THEN
62	heimbach	1.1	fac = 1. _d 0
63	jmc	1.5	ELSE
64	heimbach	1.1	fac = 0. _d 0
65	jmc	1.5	ENDIF
66
67	heimbach	1.1	print*,'QQ alpha before', alpha(20,10,1,1)
68
69	heimbach	1.2	#ifdef ALLOW_GEN2D_CONTROL
70	jmc	1.5	il=ILNBLNK( xx_gen2d_file )
71			WRITE(fnamegen2d(1:80),'(2a,i10.10)')
72	heimbach	1.2	& xx_gen2d_file(1:il),'.',optimcycle
73	jmc	1.5	CALL ACTIVE_READ_XY( fnamegen2d, tmpfld2d, 1,
74	heimbach	1.1	& doglobalread, ladinit, optimcycle,
75	jmc	1.5	& myThid, xx_gen2d_dummy )
76	heimbach	1.2
77			DO bj=myByLo(myThid),myByHi(myThid)
78	jmc	1.5	DO bi=myBxLo(myThid),myBxHi(myThid)
79			DO j = 1, sNy
80			DO i = 1, sNx
81			alpha (i,j,bi,bj) = alpha(i,j,bi,bj)
82			& + fac*tmpfld2d(i,j,bi,bj)
83			ENDDO
84			ENDDO
85			ENDDO
86			ENDDO
87	heimbach	1.1	cswd -- QQ limits!
88	jmc	1.5	cph IF (alpha(i,j,bi,bj).GT.alphamax) THEN
89	heimbach	1.1	cph alpha(i,j,bi,bj)=alphamax
90	jmc	1.5	cph ENDIF
91			cph IF (alpha(i,j,bi,bj).LT.alphamin) THEN
92	heimbach	1.1	cph alpha(i,j,bi,bj)=alphamin
93	jmc	1.5	cph ENDIF
94	heimbach	1.1	cswd -- QQ limits
95	jmc	1.5	print*,'QQ - preturb alpha', alpha(20,10,1,1),
96	heimbach	1.3	& tmpfld2d(20,10,1,1)
97	jmc	1.5	#endif /* ALLOW_GEN2D_CONTROL */
98	heimbach	1.3
99			#ifdef ALLOW_DIC_CONTROL
100
101	jmc	1.5	DO bj=myByLo(myThid),myByHi(myThid)
102			DO bi=myBxLo(myThid),myBxHi(myThid)
103			DO j = 1, sNy
104			DO i = 1, sNx
105			feload(i,j,bi,bj) = feload(i,j,bi,bj)*(1. _d 0 +xx_dic(1))
106			rain_ratio(i,j,bi,bj) =
107			& rain_ratio(i,j,bi,bj)*(1. _d 0 +xx_dic(2))
108			ENDDO
109			ENDDO
110			ENDDO
111			ENDDO
112
113			_EXCH_XY_RL( alpha, myThid )
114			_EXCH_XY_RL( rain_ratio, myThid )
115			_EXCH_XY_RL( feload, myThid )
116
117			KScav = KScav * ( 1. _d 0 + xx_dic(3)*1. _d 6 )
118			ligand_stab = ligand_stab * ( 1. _d 0 + xx_dic(4)*1. _d 6 )
119			ligand_tot = ligand_tot * ( 1. _d 0 + xx_dic(5)*1. _d 6 )
120	heimbach	1.1
121			print *,'COST KScav = ', KScav
122			print *,'COST ligand_stab = ', ligand_stab
123			print *,'COST ligand_tot = ', ligand_tot
124
125	jmc	1.5	#endif /* ALLOW_DIC_CONTROL */
126	heimbach	1.2
127	jmc	1.5	#endif /* ALLOW_CTRL */
128	heimbach	1.3
129	heimbach	1.1	cph#endif /* DIC_BIOTIC */
130
131	jmc	1.5	RETURN
132			END