/[MITgcm]/MITgcm/pkg/seaice/seaice_itd_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/seaice/seaice_itd_pickup.F

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

revision 1.1 by heimbach, Mon Oct 22 21:14:07 2012 UTC revision 1.5 by mlosch, Fri Apr 29 14:28:38 2016 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "SEAICE_OPTIONS.h"  #include "SEAICE_OPTIONS.h"
5    #ifdef ALLOW_AUTODIFF
6    # include "AUTODIFF_OPTIONS.h"
7    #endif
8    
9  C !ROUTINE: SEAICE_ITD_PICKUP  C !ROUTINE: SEAICE_ITD_PICKUP
10    
# Line 21  C     |      into the correct category b Line 26  C     |      into the correct category b
26  C     |      -> simpleSchemeFlag = .TRUE.  C     |      -> simpleSchemeFlag = .TRUE.
27  C     |  C     |
28  C     |   b) a scheme that assumes a log-normal distribution based  C     |   b) a scheme that assumes a log-normal distribution based
29  C     |      on the mean ice thickness and a standard decviation  C     |      on the mean ice thickness and a standard decviation
30  C     |      of LND_sigma=0.25  C     |      of LND_sigma=0.25
31  C     |      -> simpleSchemeFlag = .FALSE.  C     |      -> simpleSchemeFlag = .FALSE.
32  C     |  C     |
# Line 75  C Line 80  C
80  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
81        _RL dummyTime        _RL dummyTime
82    
83  C     local variables for picking up ITD from single category pickup file  C     local variables for picking up ITD from single category pickup file
84        INTEGER LND_i, LND_iend        INTEGER LND_i, LND_iend
85  C     parameters for log-normal distribution (LND)  C     parameters for log-normal distribution (LND)
86        _RL LND_sigma, LND_mu        _RL LND_sigma, LND_mu
# Line 83  C     parameters for log-normal distribu Line 88  C     parameters for log-normal distribu
88        _RL LND_dx        _RL LND_dx
89        _RL LND_tmp        _RL LND_tmp
90  C     bin width of distribution  C     bin width of distribution
91        PARAMETER(LND_dx=0.1)        PARAMETER( LND_iend = 1000 )
92        PARAMETER(LND_iend=INT(100./LND_dx))        PARAMETER( LND_dx = 100.D0 / LND_iend )
93        _RL LND_x  (INT(LND_iend))  c     PARAMETER(LND_dx=0.1)
94        _RL LND_pdf(INT(LND_iend))  c     PARAMETER(LND_iend=INT(100./LND_dx))
95          _RL LND_x  (LND_iend)
96          _RL LND_pdf(LND_iend)
97  C     flag for pickup scheme  C     flag for pickup scheme
98        LOGICAL simpleSchemeFlag        LOGICAL simpleSchemeFlag
99    
# Line 94  C     flag for pickup scheme Line 101  C     flag for pickup scheme
101        dummyTime = 1.0        dummyTime = 1.0
102    
103  C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
104    C     reset ITD variables to zero for safety
105          DO k = 1, nITD
106           DO bj=myByLo(myThid),myByHi(myThid)
107            DO bi=myBxLo(myThid),myBxHi(myThid)
108             DO j=1-OLy,sNy+OLy
109              DO i=1-OLx,sNx+OLx
110               AREAITD(i,j,k,bi,bj)  = 0. _d 0
111               HEFFITD(i,j,k,bi,bj)  = 0. _d 0
112               HSNOWITD(i,j,k,bi,bj) = 0. _d 0
113              ENDDO
114             ENDDO
115            ENDDO
116           ENDDO
117          ENDDO
118        IF (simpleSchemeFlag) THEN        IF (simpleSchemeFlag) THEN
119  C--      Put all ice into one bin:  C--      Put all ice into one bin:
120  C  C
121           DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
122            DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
123             DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
124              DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
125               AREAITD(i,j,1,bi,bj)  = AREA(i,j,bi,bj)             AREAITD(i,j,1,bi,bj)  = AREA(i,j,bi,bj)
126               HEFFITD(i,j,1,bi,bj)  = HEFF(i,j,bi,bj)             HEFFITD(i,j,1,bi,bj)  = HEFF(i,j,bi,bj)
127               HSNOWITD(i,j,1,bi,bj) = HSNOW(i,j,bi,bj)             HSNOWITD(i,j,1,bi,bj) = HSNOW(i,j,bi,bj)
             ENDDO  
            ENDDO  
128            ENDDO            ENDDO
129           ENDDO           ENDDO
130            ENDDO
131           ENDDO
132    
133  C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
134        ELSE        ELSE
# Line 119  C--      Assume log-normal ITD: Line 140  C--      Assume log-normal ITD:
140              DO i=1-OLx,sNx+OLx              DO i=1-OLx,sNx+OLx
141  C  C
142  C            initialize log-normal distribution  C            initialize log-normal distribution
143               LND_mu = log(HEFF(i,j,bi,bj)/AREA(i,j,bi,bj))               LND_mu = log(HEFF(i,j,bi,bj)/AREA(i,j,bi,bj))
144       &                - 0.5*LND_sigma*LND_sigma       &                - 0.5*LND_sigma*LND_sigma
145               LND_x(1) = 0.+LND_dx/2.               LND_x(1) = 0.+LND_dx/2.
146  C            make thickness bins  C            make thickness bins
147               DO LND_i=2,LND_iend               DO LND_i=2,LND_iend
148                LND_x(LND_i)=LND_x(LND_i-1)+LND_dx                LND_x(LND_i)=LND_x(LND_i-1)+LND_dx
149               ENDDO               ENDDO
150  C            log-normal distribution:  C            log-normal distribution:
151               DO LND_i=2,LND_iend               DO LND_i=2,LND_iend
152                LND_tmp = log(LND_x(LND_i))-LND_mu                LND_tmp = log(LND_x(LND_i))-LND_mu
153                LND_pdf(LND_i)= 1.                LND_pdf(LND_i)= 1.
154       &             / (LND_x(LND_i)*LND_sigma*sqrt(2*3.1416))       &             / (LND_x(LND_i)*LND_sigma*sqrt(2*3.1416))
155       &             * exp( -(LND_tmp*LND_tmp)       &             * exp( -(LND_tmp*LND_tmp)
156       &             /       (2*LND_sigma*LND_sigma) )       &             /       (2*LND_sigma*LND_sigma) )
157       &             * AREA(i,j,bi,bj)       &             * AREA(i,j,bi,bj)
158               ENDDO               ENDDO
159  C            assign bins to ice thickness categories  C            assign bins to ice thickness categories
160               k=1               k=1
161               DO LND_i=1,LND_iend               DO LND_i=1,LND_iend
162                IF ( LND_x(LND_i).GT.Hlimit(k) ) k=k+1                IF ( LND_x(LND_i).GT.Hlimit(k) ) k=k+1
163                AREAITD(i,j,k,bi,bj) = AREAITD(i,j,k,bi,bj)                AREAITD(i,j,k,bi,bj) = AREAITD(i,j,k,bi,bj)
164       &                             + LND_pdf(LND_i)*LND_dx       &                             + LND_pdf(LND_i)*LND_dx
165                HEFFITD(i,j,k,bi,bj) = HEFFITD(i,j,k,bi,bj)                HEFFITD(i,j,k,bi,bj) = HEFFITD(i,j,k,bi,bj)
166       &                             + LND_pdf(LND_i)*LND_x(LND_i)*LND_dx       &                             + LND_pdf(LND_i)*LND_x(LND_i)*LND_dx
167               ENDDO               ENDDO
168  C  C
169              ENDDO              ENDDO
170             ENDDO             ENDDO
171            ENDDO            ENDDO
172           ENDDO           ENDDO
173    
174        ENDIF        ENDIF
175    
176  C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
177  C     finally sort into correct ice thickness category  C     finally sort into correct ice thickness category
178  C      and compute bulk variables  C      and compute bulk variables
179  C      (needed for dynamic solver at beginning of seaice_model.F)  C      (needed for dynamic solver at beginning of seaice_model.F)
180        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
181         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
# Line 166  C      (needed for dynamic solver at beg Line 187  C      (needed for dynamic solver at beg
187  C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+-|--1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
188  #endif /* SEAICE_ITD */  #endif /* SEAICE_ITD */
189        RETURN        RETURN
190        END SUBROUTINE SEAICE_ITD_PICKUP        END
   

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5

  ViewVC Help
Powered by ViewVC 1.1.22