pkg/seaice/seaice_itd_pickup.F

86b84a92fc Patr*0001 #include "SEAICE_OPTIONS.h"
                0002
e7af59f6fd Jean*0003 CBOP
86b84a92fc Patr*0004 C !ROUTINE: SEAICE_ITD_PICKUP
                0005
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE SEAICE_ITD_PICKUP(
                0008      I     myIter, myThid )
                0009
                0010 C !DESCRIPTION: \bv
                0011 C     *===========================================================*
                0012 C     | SUBROUTINE SEAICE_ITD_PICKUP
                0013 C     | o called in case pickup file does not contain
                0014 C     |   ITD variables but mean ice thickness and concentration
                0015 C     |
                0016 C     | o choose between two schemes:
                0017 C     |
                0018 C     |   a) a simple scheme where the mean values are just put
                0019 C     |      into the first ITD category and then redustributed
                0020 C     |      into the correct category by SEAICE_ITD_REDIST
                0021 C     |      -> simpleSchemeFlag = .TRUE.
                0022 C     |
                0023 C     |   b) a scheme that assumes a log-normal distribution based
b8f04b8c26 Jean*0024 C     |      on the mean ice thickness and a standard decviation
86b84a92fc Patr*0025 C     |      of LND_sigma=0.25
                0026 C     |      -> simpleSchemeFlag = .FALSE.
                0027 C     |
                0028 C     | Torge Martin, Mai 2012, torge@mit.edu
                0029 C     *===========================================================*
                0030 C \ev
                0031
                0032 C !USES: ===============================================================
                0033       IMPLICIT NONE
                0034
                0035 C     === Global variables needed ===
                0036 C     AREA      :: total sea ice area fraction
                0037 C     HEFF      :: mean in-situ sea ice thickness
                0038 C     HSNOW     :: mean in-situ snow layer depth
                0039 C
                0040 C     === Global variables to be changed ===
                0041 C     AREAITD   :: sea ice area      by category
                0042 C     HEFFITD   :: sea ice thickness by category
                0043 C     HSNOWITD  :: snow thickness    by category
                0044 C
                0045 #include "SIZE.h"
                0046 #include "EEPARAMS.h"
e7af59f6fd Jean*0047 c#include "PARAMS.h"
86b84a92fc Patr*0048 #include "SEAICE_SIZE.h"
                0049 #include "SEAICE_PARAMS.h"
                0050 #include "SEAICE.h"
                0051
                0052 C !INPUT PARAMETERS: ===================================================
                0053 C     === Routine arguments ===
                0054 C     myIter    :: iteration number
                0055 C     myThid    :: Thread no. that called this routine.
                0056       INTEGER myIter
                0057       INTEGER myThid
e7af59f6fd Jean*0058 CEOP
86b84a92fc Patr*0059
                0060 #ifdef SEAICE_ITD
                0061
                0062 C !LOCAL VARIABLES: ====================================================
                0063 C     === Local variables ===
                0064 C     i,j,bi,bj,k :: Loop counters
                0065 C     nITD        :: number of sea ice thickness categories
                0066 C
                0067       INTEGER i, j, bi, bj, k
                0068       _RL dummyTime
                0069
b8f04b8c26 Jean*0070 C     local variables for picking up ITD from single category pickup file
86b84a92fc Patr*0071       INTEGER LND_i, LND_iend
                0072 C     parameters for log-normal distribution (LND)
                0073       _RL LND_sigma, LND_mu
                0074       PARAMETER(LND_sigma=0.25)
                0075       _RL LND_dx
                0076       _RL LND_tmp
                0077 C     bin width of distribution
961986e585 Jean*0078       PARAMETER( LND_iend = 1000 )
                0079       PARAMETER( LND_dx = 100.D0 / LND_iend )
                0080 c     PARAMETER(LND_dx=0.1)
                0081 c     PARAMETER(LND_iend=INT(100./LND_dx))
                0082       _RL LND_x  (LND_iend)
                0083       _RL LND_pdf(LND_iend)
86b84a92fc Patr*0084 C     flag for pickup scheme
                0085       LOGICAL simpleSchemeFlag
                0086
                0087       simpleSchemeFlag = .TRUE.
                0088       dummyTime = 1.0
                0089
                0090 C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0001f47137 Mart*0091 C     reset ITD variables to zero for safety
                0092       DO k = 1, nITD
                0093        DO bj=myByLo(myThid),myByHi(myThid)
                0094         DO bi=myBxLo(myThid),myBxHi(myThid)
                0095          DO j=1-OLy,sNy+OLy
                0096           DO i=1-OLx,sNx+OLx
                0097            AREAITD(i,j,k,bi,bj)  = 0. _d 0
                0098            HEFFITD(i,j,k,bi,bj)  = 0. _d 0
                0099            HSNOWITD(i,j,k,bi,bj) = 0. _d 0
                0100           ENDDO
                0101          ENDDO
                0102         ENDDO
                0103        ENDDO
                0104       ENDDO
86b84a92fc Patr*0105       IF (simpleSchemeFlag) THEN
                0106 C--      Put all ice into one bin:
                0107 C
0001f47137 Mart*0108        DO bj=myByLo(myThid),myByHi(myThid)
                0109         DO bi=myBxLo(myThid),myBxHi(myThid)
                0110          DO j=1-OLy,sNy+OLy
                0111           DO i=1-OLx,sNx+OLx
                0112            AREAITD(i,j,1,bi,bj)  = AREA(i,j,bi,bj)
                0113            HEFFITD(i,j,1,bi,bj)  = HEFF(i,j,bi,bj)
                0114            HSNOWITD(i,j,1,bi,bj) = HSNOW(i,j,bi,bj)
86b84a92fc Patr*0115           ENDDO
                0116          ENDDO
0001f47137 Mart*0117         ENDDO
                0118        ENDDO
86b84a92fc Patr*0119
                0120 C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0121       ELSE
                0122 C--      Assume log-normal ITD:
                0123
                0124          DO bj=myByLo(myThid),myByHi(myThid)
                0125           DO bi=myBxLo(myThid),myBxHi(myThid)
                0126            DO j=1-OLy,sNy+OLy
                0127             DO i=1-OLx,sNx+OLx
                0128 C
                0129 C            initialize log-normal distribution
b8f04b8c26 Jean*0130              LND_mu = log(HEFF(i,j,bi,bj)/AREA(i,j,bi,bj))
86b84a92fc Patr*0131      &                - 0.5*LND_sigma*LND_sigma
b8f04b8c26 Jean*0132              LND_x(1) = 0.+LND_dx/2.
86b84a92fc Patr*0133 C            make thickness bins
b8f04b8c26 Jean*0134              DO LND_i=2,LND_iend
                0135               LND_x(LND_i)=LND_x(LND_i-1)+LND_dx
                0136              ENDDO
86b84a92fc Patr*0137 C            log-normal distribution:
b8f04b8c26 Jean*0138              DO LND_i=2,LND_iend
                0139               LND_tmp = log(LND_x(LND_i))-LND_mu
                0140               LND_pdf(LND_i)= 1.
                0141      &             / (LND_x(LND_i)*LND_sigma*sqrt(2*3.1416))
86b84a92fc Patr*0142      &             * exp( -(LND_tmp*LND_tmp)
                0143      &             /       (2*LND_sigma*LND_sigma) )
                0144      &             * AREA(i,j,bi,bj)
b8f04b8c26 Jean*0145              ENDDO
86b84a92fc Patr*0146 C            assign bins to ice thickness categories
                0147              k=1
b8f04b8c26 Jean*0148              DO LND_i=1,LND_iend
                0149               IF ( LND_x(LND_i).GT.Hlimit(k) ) k=k+1
86b84a92fc Patr*0150               AREAITD(i,j,k,bi,bj) = AREAITD(i,j,k,bi,bj)
                0151      &                             + LND_pdf(LND_i)*LND_dx
                0152               HEFFITD(i,j,k,bi,bj) = HEFFITD(i,j,k,bi,bj)
                0153      &                             + LND_pdf(LND_i)*LND_x(LND_i)*LND_dx
b8f04b8c26 Jean*0154              ENDDO
86b84a92fc Patr*0155 C
                0156             ENDDO
b8f04b8c26 Jean*0157            ENDDO
86b84a92fc Patr*0158           ENDDO
b8f04b8c26 Jean*0159          ENDDO
86b84a92fc Patr*0160
                0161       ENDIF
                0162
                0163 C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
b8f04b8c26 Jean*0164 C     finally sort into correct ice thickness category
                0165 C      and compute bulk variables
86b84a92fc Patr*0166 C      (needed for dynamic solver at beginning of seaice_model.F)
                0167       DO bj=myByLo(myThid),myByHi(myThid)
                0168        DO bi=myBxLo(myThid),myBxHi(myThid)
                0169         CALL SEAICE_ITD_REDIST( bi, bj, dummyTime, myIter, myThid)
                0170         CALL SEAICE_ITD_SUM( bi, bj, dummyTime, myIter, myThid)
                0171        ENDDO
                0172       ENDDO
                0173
                0174 C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0175 #endif /* SEAICE_ITD */
                0176       RETURN
b8f04b8c26 Jean*0177       END