pkg/seaice/seaice_diagnostics_state.F

b585da0506 Mart*0001 #include "SEAICE_OPTIONS.h"
                0002
                0003 CBOP
9553f7b785 Jean*0004 C     !ROUTINE: SEAICE_DIAGNOSTICS_STATE
b585da0506 Mart*0005 C     !INTERFACE:
9553f7b785 Jean*0006       SUBROUTINE SEAICE_DIAGNOSTICS_STATE(
b585da0506 Mart*0007      I                      myTime, myIter, myThid )
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
9553f7b785 Jean*0010 C     | S/R  SEAICE_DIAGNOSTICS_STATE
b585da0506 Mart*0011 C     | o fill-in diagnostics array for SEAICE state variables
                0012 C     *==========================================================*
                0013 C     \ev
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017
                0018 C     == Global variables ==
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
ccaa3c61f4 Patr*0022 #include "SEAICE_SIZE.h"
b585da0506 Mart*0023 #include "SEAICE_PARAMS.h"
                0024 #include "SEAICE.h"
ccaa3c61f4 Patr*0025 #include "SEAICE_TRACER.h"
b585da0506 Mart*0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     == Routine Arguments ==
                0029 C     myTime  :: time counter for this thread
                0030 C     myIter  :: iteration counter for this thread
                0031 C     myThid  :: thread number for this instance of the routine.
                0032       _RL  myTime
                0033       INTEGER myIter
                0034       INTEGER myThid
                0035 CEOP
                0036
                0037 #ifdef ALLOW_DIAGNOSTICS
                0038 C     == Local variables ==
5fe78992ba Mart*0039 C     bi,bj   :: tile indices
ccaa3c61f4 Patr*0040       INTEGER i,j,bi,bj
5fe78992ba Mart*0041       _RL tIce (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
055494711b Mart*0042       INTEGER k
f5282c5b03 Gael*0043       _RL recip_multDim
806aa0fc84 Mart*0044       _RL tmp
e54fe3e1f9 Gael*0045 #ifdef ALLOW_SITRACER
edfdf5fa1d Jean*0046       INTEGER iTracer
                0047       CHARACTER*8   diagName
                0048 #endif
6fd07d8ed3 Jean*0049
b585da0506 Mart*0050       LOGICAL  DIAGNOSTICS_IS_ON
                0051       EXTERNAL DIAGNOSTICS_IS_ON
                0052
                0053       IF ( useDiagnostics ) THEN
6fd07d8ed3 Jean*0054        CALL DIAGNOSTICS_FILL( AREA, 'SIarea  ', 0, 1, 0, 1,1, myThid )
                0055        CALL DIAGNOSTICS_FILL( HEFF, 'SIheff  ', 0, 1, 0, 1,1, myThid )
                0056        CALL DIAGNOSTICS_FILL( UICE, 'SIuice  ', 0, 1, 0, 1,1, myThid )
                0057        CALL DIAGNOSTICS_FILL( VICE, 'SIvice  ', 0, 1, 0, 1,1, myThid )
                0058
055494711b Mart*0059        IF ( DIAGNOSTICS_IS_ON('SItices ',myThid) ) THEN
                0060         DO bj = myByLo(myThid), myByHi(myThid)
                0061          DO bi = myBxLo(myThid), myBxHi(myThid)
806aa0fc84 Mart*0062 C     use tIce as a temporary field, as it is done in seaice_growth
055494711b Mart*0063           DO j=1,sNy
                0064            DO i=1,sNx
5fe78992ba Mart*0065             tIce(i,j,bi,bj) = 0. _d 0
055494711b Mart*0066            ENDDO
                0067           ENDDO
                0068 C     division by zero is not possible
f5282c5b03 Gael*0069           recip_multDim = 1. _d 0/SEAICE_multDim
                0070           DO k=1,SEAICE_multDim
055494711b Mart*0071            DO j=1,sNy
                0072             DO i=1,sNx
806aa0fc84 Mart*0073              tmp = 1. _d 0
                0074 #ifdef SEAICE_ITD
5fe78992ba Mart*0075              IF (AREA(i,j,bi,bj) .GT. ZERO)
                0076      &            tmp=AREAITD(i,j,K,bi,bj)/AREA(i,j,bi,bj)
806aa0fc84 Mart*0077 #endif /* SEAICE_ITD */
5fe78992ba Mart*0078              tIce(i,j,bi,bj) = tIce(i,j,bi,bj)
                0079      &            + TICES(i,j,K,bi,bj)*tmp*recip_multDim
055494711b Mart*0080             ENDDO
                0081            ENDDO
                0082           ENDDO
                0083          ENDDO
                0084         ENDDO
6fd07d8ed3 Jean*0085         CALL DIAGNOSTICS_FRACT_FILL(
806aa0fc84 Mart*0086      I                   tIce, AREA, 1. _d 0, 1, 'SItices ',
6fd07d8ed3 Jean*0087      I                   0, 1, 0, 1, 1, myThid )
055494711b Mart*0088        ENDIF
6fd07d8ed3 Jean*0089
b585da0506 Mart*0090        CALL DIAGNOSTICS_FILL(HSNOW  ,'SIhsnow ',0,1 ,0,1,1,myThid)
6fd07d8ed3 Jean*0091
8b3f46bdd1 Torg*0092 #ifdef SEAICE_ITD
                0093        CALL DIAGNOSTICS_FILL(HEFFITD ,'SIheffN ',0,nITD ,0,1,1,myThid)
                0094        CALL DIAGNOSTICS_FILL(AREAITD ,'SIareaN ',0,nITD ,0,1,1,myThid)
4f7814a019 Mart*0095        CALL DIAGNOSTICS_FILL(HSNOWITD,'SIhsnowN',0,nITD ,0,1,1,myThid)
8b3f46bdd1 Torg*0096 #endif
                0097
3721cfe5e4 Gael*0098 #ifdef ALLOW_SITRACER
5fe78992ba Mart*0099        DO iTracer = 1, SItrNumInUse
                0100         WRITE(diagName,'(A4,I2.2,A2)') 'SItr',iTracer,'  '
                0101         IF (SItrMate(iTracer).EQ.'HEFF') THEN
                0102          CALL DIAGNOSTICS_FRACT_FILL(
                0103      I        SItracer(1-OLx,1-OLy,1,1,iTracer), HEFF,
                0104      I        ONE, 1, diagName, 0, 1, 0, 1, 1, myThid )
                0105         ELSE
                0106          CALL DIAGNOSTICS_FRACT_FILL(
                0107      I        SItracer(1-OLx,1-OLy,1,1,iTracer), AREA,
                0108      I        ONE, 1, diagName, 0, 1, 0, 1, 1, myThid )
                0109         ENDIF
                0110        ENDDO
3721cfe5e4 Gael*0111 #endif
a98c4b8072 Ian *0112 #ifdef SEAICE_VARIABLE_SALINITY
fdfa8e151f Dimi*0113        CALL DIAGNOSTICS_FILL(HSALT  ,'SIhsalt ',0,1 ,0,1,1,myThid)
                0114 #endif
5fe78992ba Mart*0115 C
                0116        IF ( DIAGNOSTICS_IS_ON('SIuheff ',myThid) ) THEN
411fdb8ebc Mart*0117         DO bj = myByLo(myThid), myByHi(myThid)
                0118          DO bi = myBxLo(myThid), myBxHi(myThid)
5fe78992ba Mart*0119           DO j = 1,sNy
                0120            DO i = 1,sNx+1
                0121             tIce(i,j,bi,bj) =
9d3a1a6a39 Mart*0122 #ifdef SEAICE_CGRID
5fe78992ba Mart*0123      &           UICE(i,j,bi,bj)
9d3a1a6a39 Mart*0124 #else
                0125 C     average B-grid velocities to C-grid points
5fe78992ba Mart*0126      &           0.5 _d 0*(UICE(i,j,bi,bj)+UICE(i,j+1,bi,bj))
9d3a1a6a39 Mart*0127 #endif /* SEAICE_CGRID */
5fe78992ba Mart*0128      &           *0.5 _d 0*(HEFF(i,j,bi,bj)+HEFF(i-1,j,bi,bj))
37de51ebf5 Mart*0129            ENDDO
                0130           ENDDO
                0131          ENDDO
5fe78992ba Mart*0132         ENDDO
                0133         CALL DIAGNOSTICS_FILL(tIce,'SIuheff ',0,1,0,1,1,myThid)
                0134        ENDIF
                0135        IF ( DIAGNOSTICS_IS_ON('SIvheff ',myThid) ) THEN
                0136         DO bj = myByLo(myThid), myByHi(myThid)
                0137          DO bi = myBxLo(myThid), myBxHi(myThid)
                0138           DO j = 1,sNy+1
                0139            DO i = 1,sNx
                0140             tIce(i,j,bi,bj) =
9d3a1a6a39 Mart*0141 #ifdef SEAICE_CGRID
5fe78992ba Mart*0142      &           VICE(i,j,bi,bj)
9d3a1a6a39 Mart*0143 #else
                0144 C     average B-grid velocities to C-grid points
5fe78992ba Mart*0145      &           0.5 _d 0*(VICE(i,j,bi,bj)+VICE(i+1,j,bi,bj))
9d3a1a6a39 Mart*0146 #endif /* SEAICE_CGRID */
5fe78992ba Mart*0147      &           *0.5 _d 0*(HEFF(i,j,bi,bj)+HEFF(i,j-1,bi,bj))
37de51ebf5 Mart*0148            ENDDO
                0149           ENDDO
                0150          ENDDO
5fe78992ba Mart*0151         ENDDO
                0152         CALL DIAGNOSTICS_FILL(tIce,'SIvheff ',0,1,0,1,1,myThid)
                0153        ENDIF
                0154 C
b585da0506 Mart*0155 C     endif useDiagnostics
                0156       ENDIF
5fe78992ba Mart*0157
b585da0506 Mart*0158 #endif /* ALLOW_DIAGNOSTICS */
                0159
                0160       RETURN
                0161       END