pkg/openad/externalDummies.F

410902f805 Patr*0001 #include "OPENAD_OPTIONS.h"
1adcf297e1 Dani*0002 #ifdef ALLOW_STREAMICE
                0003 #include "STREAMICE_OPTIONS.h"
                0004 #endif
410902f805 Patr*0005
5dddee4ea2 Jean*0006 C ###########################################################
7fd2fa3bc2 Patr*0007       SUBROUTINE DUMMY_IN_STEPPING( myTime, myIter, myThid )
                0008
                0009       IMPLICIT NONE
                0010 #include "SIZE.h"
                0011 #include "EEPARAMS.h"
                0012 #include "PARAMS.h"
                0013 #include "DYNVARS.h"
                0014       _RL     myTime
                0015       INTEGER myIter
                0016       INTEGER myThid
                0017 C dummy self dependence (nontrivial so mfef90 doesn't kill it)
                0018       theta(1,1,1,1,1)=2*theta(1,1,1,1,1)
                0019       end subroutine
                0020 C ###########################################################
ffbda4c109 Jean*0021       SUBROUTINE EXCH1_RL(
                0022      U                 array,
                0023      I                 myOLw, myOLe, myOLs, myOLn, myNz,
                0024      I                 exchWidthX, exchWidthY,
                0025      I                 cornerMode, myThid )
                0026
5dddee4ea2 Jean*0027       IMPLICIT NONE
                0028 #include "SIZE.h"
                0029 #include "EEPARAMS.h"
                0030 #include "EXCH.h"
ffbda4c109 Jean*0031       INTEGER myOLw, myOLe, myOLs, myOLn, myNz
                0032       _RL     array( 1-myOLw:sNx+myOLe,
                0033      &               1-myOLs:sNy+myOLn,
                0034      &               myNz, nSx, nSy )
                0035       INTEGER exchWidthX
                0036       INTEGER exchWidthY
                0037       INTEGER cornerMode
5dddee4ea2 Jean*0038       INTEGER myThid
bdadc40459 Jean*0039 C dummy self dependence (nontrivial so mfef90 doesn't kill it)
                0040       array(1,1,1,1,1)=2*array(1,1,1,1,1)
5dddee4ea2 Jean*0041       end subroutine
                0042 C ###########################################################
ffbda4c109 Jean*0043 C      SUBROUTINE EXCH1_RS(
                0044 C     U                 array,
                0045 C     I                 myOLw, myOLe, myOLs, myOLn, myNz,
                0046 C     I                 exchWidthX, exchWidthY,
                0047 C     I                 cornerMode, myThid )
                0048 C
5dddee4ea2 Jean*0049 C      IMPLICIT NONE
                0050 C#include "SIZE.h"
                0051 C#include "EEPARAMS.h"
                0052 C#include "EXCH.h"
ffbda4c109 Jean*0053 C      INTEGER myOLw, myOLe, myOLs, myOLn, myNz
                0054 C      _RS     array( 1-myOLw:sNx+myOLe,
                0055 C     &               1-myOLs:sNy+myOLn,
                0056 C     &               myNz, nSx, nSy )
                0057 C      INTEGER exchWidthX
                0058 C      INTEGER exchWidthY
                0059 C      INTEGER cornerMode
5dddee4ea2 Jean*0060 C      INTEGER myThid
                0061 C      end subroutine
                0062 C ###########################################################
                0063 C      SUBROUTINE GLOBAL_MAX_R8(
                0064 C     U                       maxphi,
                0065 C     I                       myThid )
                0066 C      IMPLICIT NONE
                0067 C#include "SIZE.h"
                0068 C#include "EEPARAMS.h"
                0069 C#include "EESUPPORT.h"
                0070 C#include "EXCH.h"
                0071 C      Real*8 maxPhi
                0072 C      INTEGER myThid
                0073 C      maxPhi=2*maxPhi
                0074 C      end subroutine
                0075 C ###########################################################
2ebb062246 Jean*0076 C      SUBROUTINE GLOBAL_SUM_R8(
                0077 C     U                       sumphi,
                0078 C     I                       myThid )
                0079 C      IMPLICIT NONE
                0080 C#include "SIZE.h"
                0081 C#include "EEPARAMS.h"
                0082 C#include "EESUPPORT.h"
                0083 C#include "EXCH.h"
                0084 C      Real*8 sumPhi
                0085 C      INTEGER myThid
                0086 CC dummy self dependence (nontrivial so mfef90 doesn't kill it)
                0087 C      sumPhi=2*sumPhi
                0088 C      end subroutine
                0089 C ###########################################################
                0090       SUBROUTINE GLOBAL_SUM_TILE_RL(
                0091      U                       phiTile,
5dddee4ea2 Jean*0092      U                       sumphi,
                0093      I                       myThid )
                0094       IMPLICIT NONE
                0095 #include "SIZE.h"
                0096 #include "EEPARAMS.h"
                0097 #include "EESUPPORT.h"
                0098 #include "EXCH.h"
2ebb062246 Jean*0099       _RL phiTile(nSx,nSy)
                0100       _RL sumPhi
5dddee4ea2 Jean*0101       INTEGER myThid
bdadc40459 Jean*0102 C dummy self dependence (nontrivial so mfef90 doesn't kill it)
2ebb062246 Jean*0103       sumPhi=2*phiTile(1,1)
5dddee4ea2 Jean*0104       end subroutine
                0105 C ###########################################################
5dac35defb Patr*0106 #ifndef ALLOW_STREAMICE
5dddee4ea2 Jean*0107       SUBROUTINE CG2D(
                0108      I                cg2d_b,
                0109      U                cg2d_x,
                0110      O                firstResidual,
5736c356f8 Jean*0111      O                minResidualSq,
5dddee4ea2 Jean*0112      O                lastResidual,
                0113      U                numIters,
5736c356f8 Jean*0114      O                nIterMin,
5dddee4ea2 Jean*0115      I                myThid )
                0116       IMPLICIT NONE
                0117 #include "SIZE.h"
                0118 #include "EEPARAMS.h"
                0119 #include "PARAMS.h"
                0120 #include "CG2D.h"
                0121       Real*8  cg2d_b(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0122       Real*8  cg2d_x(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0123       Real*8  firstResidual
5736c356f8 Jean*0124       Real*8  minResidualSq
5dddee4ea2 Jean*0125       Real*8  lastResidual
                0126       INTEGER numIters
5736c356f8 Jean*0127       INTEGER nIterMin
5dddee4ea2 Jean*0128       INTEGER myThid
bdadc40459 Jean*0129 C dummy self dependence (nontrivial so mfef90 doesn't kill it)
                0130       cg2d_x(1,1,1,1)=2*cg2d_b(1,1,1,1)
5dddee4ea2 Jean*0131       end subroutine
5dac35defb Patr*0132 #endif
                0133 C ###########################################################
                0134 #ifdef ALLOW_STREAMICE
de57a2ec4b Mart*0135       SUBROUTINE STREAMICE_CG_SOLVE(
5dac35defb Patr*0136      U                               cg_Uin,     ! x-velocities
                0137      U                               cg_Vin,     ! y-velocities
                0138      I                               cg_Bu,      ! force in x dir
                0139      I                               cg_Bv,      ! force in y dir
                0140      I                               A_uu,       ! section of matrix that multiplies u and projects on u
                0141      I                               A_uv,       ! section of matrix that multiplies v and projects on u
                0142      I                               A_vu,       ! section of matrix that multiplies u and projects on v
                0143      I                               A_vv,       ! section of matrix that multiplies v and projects on v
de57a2ec4b Mart*0144      I                               tolerance,
5dac35defb Patr*0145      O                               iters,
                0146      I                               maxiter,
                0147      I                               myThid )
                0148       IMPLICIT NONE
                0149
                0150 #include "SIZE.h"
                0151 #include "EEPARAMS.h"
                0152 #include "PARAMS.h"
                0153 #include "STREAMICE.h"
                0154 #include "STREAMICE_CG.h"
                0155       INTEGER myThid
                0156       INTEGER iters
                0157       INTEGER maxiter
                0158       _RL tolerance
                0159       _RL cg_Uin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0160       _RL cg_Vin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0161       _RL cg_Bu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0162       _RL cg_Bv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
de57a2ec4b Mart*0163       _RL
5dac35defb Patr*0164      & A_uu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0165      & A_vu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0166      & A_uv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
                0167      & A_vv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
                0168
de57a2ec4b Mart*0169       cg_Uin(1,1,1,1) = A_uu(1,1,1,1,1,1) + A_uv(1,1,1,1,1,1) +
                0170      & A_vu(1,1,1,1,1,1) + A_vv(1,1,1,1,1,1) + cg_Bu(1,1,1,1)
5dac35defb Patr*0171
de57a2ec4b Mart*0172       cg_Vin(1,1,1,1) = A_uu(1,1,1,1,1,1) + A_uv(1,1,1,1,1,1) +
                0173      & A_vu(1,1,1,1,1,1) + A_vv(1,1,1,1,1,1) + cg_Bv(1,1,1,1)
5dac35defb Patr*0174
                0175       end subroutine
                0176 #endif /* ALLOW_STREAMICE */
1a5e3fa960 Patr*0177 C ###########################################################
1adcf297e1 Dani*0178 #ifdef ALLOW_STREAMICE
                0179        SUBROUTINE STREAMICE_INVERT_SURF_FORTHICK (
                0180      O            H,
                0181      I            s,
                0182      I            R,
                0183      I            delta,
                0184      I            myThid)
                0185
                0186 #include "SIZE.h"
                0187 #include "GRID.h"
                0188 #include "SET_GRID.h"
                0189 #include "EEPARAMS.h"
                0190 #include "PARAMS.h"
                0191 #include "STREAMICE.h"
                0192
                0193       _RL H(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0194       _RL S(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0195       _RL R(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0196       _RL DELTA
                0197       INTEGER myThid
                0198 #ifdef STREAMICE_ALLOW_DEPTH_CONTROL
de57a2ec4b Mart*0199       H(1,1,1,1) = s(1,1,1,1) +
                0200      &  R(1,1,1,1)
1adcf297e1 Dani*0201 #endif
                0202
                0203       end subroutine
                0204 #endif /* ALLOW_STREAMICE */
                0205 C ###########################################################
                0206 #ifdef ALLOW_STREAMICE
                0207        SUBROUTINE STREAMICE_SMOOTH_ADJOINT_FIELD (
                0208      O            X,
                0209      I            myThid)
                0210
                0211 #include "SIZE.h"
                0212 #include "GRID.h"
                0213 #include "EEPARAMS.h"
                0214
                0215       _RL X(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0216       INTEGER myThid
                0217
                0218       INTEGER i, j, bi, bj, k
                0219       _RL q_int1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0220       _RL q_int2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0221
                0222       DO bj = myByLo(myThid), myByHi(myThid)
                0223        DO bi = myBxLo(myThid), myBxHi(myThid)
                0224         DO j=1-OLy,sNy+OLy
                0225          DO i=1-OLx,sNx+OLx
                0226
                0227           q_int1(i,j,bi,bj) = 0.0
                0228           q_int2(i,j,bi,bj) = 0.0
                0229           X(i,j,bi,bj) = X(i,j,bi,bj) * 1.0
                0230           k=0
                0231          ENDDO
                0232         ENDDO
                0233        ENDDO
                0234       ENDDO
                0235
                0236
                0237       end subroutine
                0238 #endif /* ALLOW_STREAMICE */
                0239 C ###########################################################
6f5d7c9095 Patr*0240       subroutine active_read_xyz(
                0241      I                           active_var_file,
                0242      O                           active_var,
                0243      I                           iRec,
                0244      I                           doglobalread,
                0245      I                           lAdInit,
                0246      I                           myOptimIter,
                0247      I                           myThid,
                0248      I                           dummy
                0249      &                         )
                0250 ! xxx template ad_template.active_read_xyz.f90
                0251         implicit none
                0252 !     == global variables ==
                0253 #include "EEPARAMS.h"
                0254 #include "SIZE.h"
de57a2ec4b Mart*0255       CHARACTER*(*) active_var_file
6f5d7c9095 Patr*0256       _RL     active_var(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0257       INTEGER iRec
                0258       INTEGER myOptimIter
                0259       INTEGER myThid
                0260       LOGICAL doglobalread
                0261       LOGICAL lAdInit
                0262       _RL     dummy
                0263 #ifdef ALLOW_OPENAD_ACTIVE_READ_XYZ
                0264       active_var = dummy + active_var
                0265       dummy = active_var(1,1,1,1,1) + dummy
6e6e03273c Patr*0266 #endif /* ALLOW_OPENAD_ACTIVE_READ_XYZ */
6f5d7c9095 Patr*0267       end subroutine
                0268 C ###########################################################
1b54713652 Patr*0269       subroutine active_read_xy(
1a5e3fa960 Patr*0270      I                           active_var_file,
                0271      O                           active_var,
                0272      I                           iRec,
                0273      I                           doglobalread,
                0274      I                           lAdInit,
                0275      I                           myOptimIter,
                0276      I                           myThid,
                0277      I                           dummy
                0278      &                         )
6f5d7c9095 Patr*0279 ! xxx template ad_template.active_read_xy.f90
1a5e3fa960 Patr*0280         implicit none
                0281 !     == global variables ==
                0282 #include "EEPARAMS.h"
                0283 #include "SIZE.h"
de57a2ec4b Mart*0284       CHARACTER*(*) active_var_file
1a5e3fa960 Patr*0285       _RL     active_var(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0286       INTEGER iRec
                0287       INTEGER myOptimIter
                0288       INTEGER myThid
                0289       LOGICAL doglobalread
                0290       LOGICAL lAdInit
                0291       _RL     dummy
6f5d7c9095 Patr*0292 #ifdef ALLOW_OPENAD_ACTIVE_READ_XY
1a5e3fa960 Patr*0293       active_var = dummy + active_var
                0294       dummy = active_var(1,1,1,1) + dummy
6f5d7c9095 Patr*0295 #endif /* ALLOW_OPENAD_ACTIVE_READ_XY */
1a5e3fa960 Patr*0296       end subroutine
5dac35defb Patr*0297 C ###########################################################
4a33dbfb87 Patr*0298       subroutine active_write_xy(
                0299      I                           active_var_file,
                0300      I                           active_var,
                0301      I                           iRec,
                0302      I                           myOptimIter,
                0303      I                           myThid,
                0304      I                           dummy
                0305      &                         )
                0306 ! xxx template ad_template.active_write_xy.f90
                0307         implicit none
                0308 !     == global variables ==
                0309 #include "EEPARAMS.h"
                0310 #include "SIZE.h"
de57a2ec4b Mart*0311       CHARACTER*(*) active_var_file
4a33dbfb87 Patr*0312       _RL     active_var(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0313       INTEGER iRec
                0314       INTEGER myOptimIter
                0315       INTEGER myThid
                0316       _RL     dummy
                0317 #ifdef ALLOW_OPENAD_ACTIVE_WRITE
                0318       active_var = dummy + active_var
                0319       dummy = active_var(1,1,1,1) + dummy
                0320 #endif /* ALLOW_OPENAD_ACTIVE_WRITE */
                0321       end subroutine
                0322 C ###########################################################