pkg/streamice/streamice_apply_flux_ctrl.F

5ca83cd8f7 Dani*0001 #include "STREAMICE_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004
                0005 CBOP
                0006       SUBROUTINE STREAMICE_APPLY_FLUX_CTRL ( myThid )
                0007
                0008 C     /============================================================\
                0009 C     | SUBROUTINE                                                 |
                0010 C     | o                                                          |
                0011 C     |============================================================|
                0012 C     |                                                            |
                0013 C     \============================================================/
                0014       IMPLICIT NONE
                0015
                0016 C     === Global variables ===
                0017 #include "SIZE.h"
                0018 #include "GRID.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "STREAMICE.h"
2a16ced2f5 Dani*0022 !#ifdef ALLOW_STREAMICE_FLUX_CONTROL
                0023 !#include "STREAMICE_CTRL_FLUX.h"
                0024 !#endif
5ca83cd8f7 Dani*0025
                0026       INTEGER myThid
                0027
                0028 #ifdef ALLOW_STREAMICE
                0029 #ifdef ALLOW_STREAMICE_FLUX_CONTROL
2a16ced2f5 Dani*0030 #ifdef STREAMICE_FALSE
5ca83cd8f7 Dani*0031       INTEGER bi, bj, i, j, k
                0032       _RS maskval
                0033       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0034       _RL streamice_flux_scale_current (n_fluxes_max)
                0035
                0036
                0037 !!!!!!!  IN PLACE OF THIS, THERE WOULD BE CALL TO SOMETHING
                0038 !!!!!!   LIKE CTRL_GENTIME_2D IN ORDER TO PROPERLY INTERPOLATE
                0039 !!!!!!   THE SCALINGS TO THE CURRENT TIME STEP
                0040
                0041       DO i=1,n_fluxes
                0042        streamice_flux_scale_current (i) =
                0043      &  streamice_ctrl_flux_scale (i,1)
                0044       ENDDO
                0045
                0046 !!!!!!!!
                0047 !!!!!!!
                0048 !!!!!!!!
                0049
                0050       DO bj = myByLo(myThid), myByHi(myThid)
                0051        DO bi = myBxLo(myThid), myBxHi(myThid)
                0052         DO j=1,sNy
                0053          DO i=1,sNx
                0054           IF (streamice_umask(i,j,bi,bj).eq.3.0 .OR.
                0055      &        streamice_vmask(i,j,bi,bj).eq.3.0) THEN
                0056
                0057            maskval = INT(streamice_ctrl_flux_mask(i,j,bi,bj))
                0058
                0059            DO k=1,n_fluxes_max
                0060             IF (maskval.eq.streamice_ctrl_flux_id(k)) THEN
                0061              IF (streamice_umask(i,j,bi,bj).eq.3.0
                0062               u_bdry_values_SI (i,j,bi,bj) =
                0063      &         u_bdry_values_SI_base(i,j,bi,bj) *
                0064      &         streamice_flux_scale_current (k)
                0065              ENDIF
                0066              IF (streamice_vmask(i,j,bi,bj).eq.3.0
                0067               v_bdry_values_SI (i,j,bi,bj) =
                0068      &         v_bdry_values_SI_base(i,j,bi,bj) *
                0069      &         streamice_flux_scale_current (k)
                0070              ENDIF
                0071              EXIT
                0072             ENDIF
                0073            ENDDO
                0074           ENDIF
                0075          ENDDO
                0076         ENDDO
                0077        ENDDO
                0078       ENDDO
                0079 #endif
                0080 #endif
2a16ced2f5 Dani*0081 #endif
5ca83cd8f7 Dani*0082       RETURN
                0083       END