/[MITgcm]/MITgcm/pkg/dic/dic_set_control.F
ViewVC logotype

Contents of /MITgcm/pkg/dic/dic_set_control.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.9 - (show annotations) (download)
Tue Sep 9 22:45:55 2014 UTC (9 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.8: +4 -1 lines
Include explicitly CTRL_OPTIONS.h (in case we don't use ECCO_CPPOPTIONS.h)

1 C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_set_control.F,v 1.8 2013/11/08 19:30:37 jahn Exp $
2 C $Name: $
3
4 #include "DIC_OPTIONS.h"
5 #ifdef ALLOW_CTRL
6 # include "CTRL_OPTIONS.h"
7 #endif
8
9 cphc$taf COMMON DIC_XX adname = addic_xx
10 cphc$taf COMMON DIC_COST_CTRL adname = ADDIC_COST_CTRL
11
12
13 C !INTERFACE: ==========================================================
14 SUBROUTINE DIC_SET_CONTROL( myThid )
15
16 C !DESCRIPTION:
17
18 C !USES: ===============================================================
19 IMPLICIT NONE
20
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 #ifdef ALLOW_CTRL
30 #include "CTRL_SIZE.h"
31 #include "ctrl.h"
32 #include "ctrl_dummy.h"
33 #include "optim.h"
34 #endif
35 C == Routine arguments ==
36 INTEGER myThid
37
38 #ifdef ALLOW_CTRL
39 cph#ifdef DIC_BIOTIC
40 C == Local arguments ==
41 INTEGER bi, bj
42 INTEGER i, j
43 INTEGER il
44 LOGICAL doglobalread
45 LOGICAL ladinit
46 LOGICAL equal
47 CHARACTER*( 80) fnamegen2d
48 _RL fac
49 c == external ==
50 INTEGER ILNBLNK
51 EXTERNAL ILNBLNK
52
53 c == end of interface ==
54 CEOP
55
56 doglobalread = .FALSE.
57 ladinit = .FALSE.
58
59 equal = .TRUE.
60
61 IF ( equal ) THEN
62 fac = 1. _d 0
63 ELSE
64 fac = 0. _d 0
65 ENDIF
66
67 print*,'QQ alpha before', alpha(20,10,1,1)
68
69 #ifdef ALLOW_GEN2D_CONTROL
70 il=ILNBLNK( xx_gen2d_file )
71 WRITE(fnamegen2d(1:80),'(2a,i10.10)')
72 & xx_gen2d_file(1:il),'.',optimcycle
73 CALL ACTIVE_READ_XY( fnamegen2d, tmpfld2d, 1,
74 & doglobalread, ladinit, optimcycle,
75 & myThid, xx_gen2d_dummy )
76
77 DO bj=myByLo(myThid),myByHi(myThid)
78 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 cswd -- QQ limits!
88 cph IF (alpha(i,j,bi,bj).GT.alphamax) THEN
89 cph alpha(i,j,bi,bj)=alphamax
90 cph ENDIF
91 cph IF (alpha(i,j,bi,bj).LT.alphamin) THEN
92 cph alpha(i,j,bi,bj)=alphamin
93 cph ENDIF
94 cswd -- QQ limits
95 print*,'QQ - preturb alpha', alpha(20,10,1,1),
96 & tmpfld2d(20,10,1,1)
97 #endif /* ALLOW_GEN2D_CONTROL */
98
99 #ifdef ALLOW_DIC_CONTROL
100
101 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
121 print *,'COST KScav = ', KScav
122 print *,'COST ligand_stab = ', ligand_stab
123 print *,'COST ligand_tot = ', ligand_tot
124
125 #endif /* ALLOW_DIC_CONTROL */
126
127 #endif /* ALLOW_CTRL */
128
129 cph#endif /* DIC_BIOTIC */
130
131 RETURN
132 END

  ViewVC Help
Powered by ViewVC 1.1.22