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

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

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

revision 1.4 by heimbach, Thu Oct 15 23:28:43 2009 UTC revision 1.5 by jmc, Wed Mar 24 03:04:38 2010 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "DIC_OPTIONS.h"  #include "DIC_OPTIONS.h"
5    
6  cphc$taf common DIC_XX        adname = addic_xx  cphc$taf COMMON DIC_XX        adname = addic_xx
7  cphc$taf common DIC_COST_CTRL adname = ADDIC_COST_CTRL  cphc$taf COMMON DIC_COST_CTRL adname = ADDIC_COST_CTRL
8    
9    
10  C !INTERFACE: ==========================================================  C !INTERFACE: ==========================================================
11        subroutine dic_set_control( myThid )        SUBROUTINE DIC_SET_CONTROL( myThid )
12    
13  C !DESCRIPTION:  C !DESCRIPTION:
14    
15  C !USES: ===============================================================  C !USES: ===============================================================
16        implicit none        IMPLICIT NONE
17    
18  C     == GLobal variables ==  C     == GLobal variables ==
19  #include "SIZE.h"  #include "SIZE.h"
# Line 30  C     == GLobal variables == Line 30  C     == GLobal variables ==
30  #include "optim.h"  #include "optim.h"
31  #endif  #endif
32  C     == Routine arguments ==  C     == Routine arguments ==
       _RL fac  
33        INTEGER myThid        INTEGER myThid
34    
35  cph#ifdef DIC_BIOTIC  cph#ifdef DIC_BIOTIC
36  C     == Local arguments ==  C     == Local arguments ==
37        INTEGER bi, bj        INTEGER bi, bj
38        INTEGER i, j        INTEGER i, j
39        integer il        INTEGER il
40        logical doglobalread        LOGICAL doglobalread
41        logical ladinit        LOGICAL ladinit
42        logical equal        LOGICAL equal
43        character*( 80)   fnamegen2d        CHARACTER*( 80)   fnamegen2d
44          _RL fac
45  c     == external ==  c     == external ==
46        integer  ilnblnk        INTEGER  ILNBLNK
47        external ilnblnk        EXTERNAL ILNBLNK
48    
49  c     == end of interface ==  c     == end of interface ==
50  CEOP  CEOP
51  #ifdef ALLOW_CTRL  #ifdef ALLOW_CTRL
52    
53        doglobalread = .false.        doglobalread = .FALSE.
54        ladinit      = .false.        ladinit      = .FALSE.
55    
56        equal = .true.        equal = .TRUE.
57    
58        if ( equal ) then        IF ( equal ) THEN
59          fac = 1. _d 0          fac = 1. _d 0
60        else        ELSE
61          fac = 0. _d 0          fac = 0. _d 0
62        endif        ENDIF
63      
64        print*,'QQ alpha before', alpha(20,10,1,1)        print*,'QQ alpha before', alpha(20,10,1,1)
65    
66  #ifdef ALLOW_GEN2D_CONTROL  #ifdef ALLOW_GEN2D_CONTROL
67        il=ilnblnk( xx_gen2d_file )        il=ILNBLNK( xx_gen2d_file )
68        write(fnamegen2d(1:80),'(2a,i10.10)')        WRITE(fnamegen2d(1:80),'(2a,i10.10)')
69       &     xx_gen2d_file(1:il),'.',optimcycle       &     xx_gen2d_file(1:il),'.',optimcycle
70        call active_read_xy( fnamegen2d, tmpfld2d, 1,        CALL ACTIVE_READ_XY( fnamegen2d, tmpfld2d, 1,
71       &                      doglobalread, ladinit, optimcycle,       &                      doglobalread, ladinit, optimcycle,
72       &                      mythid, xx_gen2d_dummy )       &                      myThid, xx_gen2d_dummy )
73    
74        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
75           DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
76             do i = 1, sNx           DO j = 1, sNy
77               do j = 1, sNy            DO i = 1, sNx
78                  alpha (i,j,bi,bj) = alpha(i,j,bi,bj) +               alpha (i,j,bi,bj) = alpha(i,j,bi,bj)
79       &               fac*tmpfld2d(i,j,bi,bj)       &                         + fac*tmpfld2d(i,j,bi,bj)
80               end do            ENDDO
81            end do           ENDDO
82          end do         ENDDO
83        end do        ENDDO
84  cswd -- QQ limits!  cswd -- QQ limits!
85  cph                if (alpha(i,j,bi,bj).gt.alphamax) then  cph                IF (alpha(i,j,bi,bj).GT.alphamax) THEN
86  cph                   alpha(i,j,bi,bj)=alphamax  cph                   alpha(i,j,bi,bj)=alphamax
87  cph                endif  cph                ENDIF
88  cph                if (alpha(i,j,bi,bj).lt.alphamin) then  cph                IF (alpha(i,j,bi,bj).LT.alphamin) THEN
89  cph                   alpha(i,j,bi,bj)=alphamin  cph                   alpha(i,j,bi,bj)=alphamin
90  cph                endif  cph                ENDIF
91  cswd -- QQ limits  cswd -- QQ limits
92        print*,'QQ - preturb alpha', alpha(20,10,1,1),        print*,'QQ - preturb alpha', alpha(20,10,1,1),
93       &                             tmpfld2d(20,10,1,1)       &                             tmpfld2d(20,10,1,1)
94  #endif  #endif /* ALLOW_GEN2D_CONTROL */
95    
96  #ifdef ALLOW_DIC_CONTROL  #ifdef ALLOW_DIC_CONTROL
97    
98         DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
99           DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
100             do i = 1, sNx           DO j = 1, sNy
101               do j = 1, sNy            DO i = 1, sNx
102                  feload(i,j,bi,bj) = feload(i,j,bi,bj)*(1.+xx_dic(1))              feload(i,j,bi,bj) = feload(i,j,bi,bj)*(1. _d 0 +xx_dic(1))
103                  rain_ratio(i,j,bi,bj) =              rain_ratio(i,j,bi,bj) =
104       &               rain_ratio(i,j,bi,bj)*(1.+xx_dic(2))       &                      rain_ratio(i,j,bi,bj)*(1. _d 0 +xx_dic(2))
105               end do            ENDDO
106            end do           ENDDO
107          end do         ENDDO
108        end do        ENDDO
109    
110        _EXCH_XY_RL( alpha, mythid )        _EXCH_XY_RL( alpha, myThid )
111        _EXCH_XY_RL( rain_ratio, mythid )        _EXCH_XY_RL( rain_ratio, myThid )
112        _EXCH_XY_RL( feload, mythid )        _EXCH_XY_RL( feload, myThid )
113    
114        KScav       = KScav       * (1.+1.e+6*xx_dic(3))        KScav       = KScav       * ( 1. _d 0 + xx_dic(3)*1. _d 6 )
115        ligand_stab = ligand_stab * (1.+1.e+6*xx_dic(4))        ligand_stab = ligand_stab * ( 1. _d 0 + xx_dic(4)*1. _d 6 )
116        ligand_tot  = ligand_tot  * (1.+1.e+6*xx_dic(5))        ligand_tot  = ligand_tot  * ( 1. _d 0 + xx_dic(5)*1. _d 6 )
117    
118        print *,'COST KScav = ', KScav        print *,'COST KScav = ', KScav
119        print *,'COST ligand_stab = ', ligand_stab        print *,'COST ligand_stab = ', ligand_stab
120        print *,'COST ligand_tot = ', ligand_tot        print *,'COST ligand_tot = ', ligand_tot
121    
122  #endif  #endif /* ALLOW_DIC_CONTROL */
123    
124  #endif  #endif /* ALLOW_CTRL */
125    
126  cph#endif /* DIC_BIOTIC */  cph#endif /* DIC_BIOTIC */
127    
128        end        RETURN
129          END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22