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

Annotation of /MITgcm/pkg/seaice/seaice_fake.F

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


Revision 1.3 - (hide annotations) (download)
Thu Jan 9 19:36:27 2014 UTC (10 years, 5 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint65, HEAD
Changes since 1.2: +10 -4 lines
- replace k (that was not initialized) with 1 for vertical level index.
- add stop to preclude use of seaice_fake (only meant for adj) in forward.

1 gforget 1.3 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_fake.F,v 1.2 2013/08/09 22:59:38 jmc Exp $
2 jmc 1.2 C $Name: $
3 gforget 1.1
4     #include "SEAICE_OPTIONS.h"
5     #ifdef ALLOW_EXF
6     # include "EXF_OPTIONS.h"
7     #endif
8    
9     C StartOfInterface
10     SUBROUTINE SEAICE_FAKE( myTime, myIter, myThid )
11 jmc 1.2 C *==========================================================*
12 gforget 1.1 C | SUBROUTINE seaice_fake (for adjoint purpose only) |
13 jmc 1.2 C *==========================================================*
14 gforget 1.1 IMPLICIT NONE
15    
16     C === Global variables ===
17     #include "SIZE.h"
18     #include "EEPARAMS.h"
19     #include "PARAMS.h"
20     #include "DYNVARS.h"
21     #include "GRID.h"
22     #include "FFIELDS.h"
23     #include "SEAICE_SIZE.h"
24     #include "SEAICE_PARAMS.h"
25     #include "SEAICE.h"
26     #ifdef ALLOW_EXF
27     # include "EXF_FIELDS.h"
28     # include "EXF_PARAM.h"
29     #endif
30     C === Routine arguments ===
31     C myTime - Simulation time
32     C myIter - Simulation timestep number
33     C myThid - Thread no. that called this routine.
34     _RL myTime
35     INTEGER myIter, myThid
36     C EndOfInterface(global-font-lock-mode 1)
37    
38     C === Local variables ===
39     C i,j,bi,bj - Loop counters
40    
41 gforget 1.3 INTEGER i, j, bi, bj
42 gforget 1.1 _RL fac, tempFrz
43 gforget 1.3 CHARACTER*(MAX_LEN_MBUF) msgBuf
44    
45     WRITE(msgBuf,'(2A)') 'SEAICE_FAKE:',
46     & ' forward code is not meant to be used (adj only)'
47     CALL PRINT_ERROR( msgBuf, myThid )
48     STOP 'ABNORMAL END: S/R SEAICE_FAKE'
49 gforget 1.1
50     DO bj=myByLo(myThid),myByHi(myThid)
51     DO bi=myBxLo(myThid),myBxHi(myThid)
52     DO j=1,sNy
53     DO i=1,sNx
54 jmc 1.2 c shielding effect
55 gforget 1.1 fac=MIN(1. _d 0, MAX(0. _d 0 , 1. _d 0 - area(i,j,bi,bj)))
56     fu(i,j,bi,bj) = fu(i,j,bi,bj) * fac
57     fv(i,j,bi,bj) = fv(i,j,bi,bj) * fac
58     qnet(i,j,bi,bj) = qnet(i,j,bi,bj) * fac
59     qsw(i,j,bi,bj) = qsw(i,j,bi,bj) * fac
60     #if (defined ALLOW_EXF) && (defined ALLOW_ATM_TEMP)
61     c the fresh water flux at the top of the ice
62 jmc 1.2 EmPmR(i,j,bi,bj) = maskC(i,j,1,bi,bj)*(
63     & fac * EVAP(i,j,bi,bj)
64     & - PRECIP(i,j,bi,bj)
65     #ifdef ALLOW_RUNOFF
66     & - RUNOFF(i,j,bi,bj)
67     #endif /* ALLOW_RUNOFF */
68 gforget 1.1 & )*rhoConstFresh
69     #endif
70     c relaxation to freezing point
71     fac=MIN(1. _d 0, MAX(0. _d 0 , area(i,j,bi,bj)))
72     tempFrz = SEAICE_tempFrz0 +
73 jmc 1.2 & SEAICE_dTempFrz_dS *salt(i,j,1,bi,bj)
74 gforget 1.3 theta(i,j,1,bi,bj)=theta(i,j,1,bi,bj) + fac *
75     & ( tempFrz-theta(i,j,1,bi,bj) ) *
76 gforget 1.1 & SEAICE_mcPheePiston/drF(1)*SEAICE_deltaTtherm
77     ENDDO
78     ENDDO
79     ENDDO
80     ENDDO
81    
82     CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
83     _EXCH_XY_RS( qnet, myThid )
84     _EXCH_XY_RS( qsw, myThid )
85     _EXCH_XY_RS( empmr, myThid )
86    
87     RETURN
88     END

  ViewVC Help
Powered by ViewVC 1.1.22