/[MITgcm]/MITgcm/verification/fizhi-gridalt-hs/code/fizhi_init_vars.F
ViewVC logotype

Diff of /MITgcm/verification/fizhi-gridalt-hs/code/fizhi_init_vars.F

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

revision 1.3 by molod, Thu May 5 21:27:39 2005 UTC revision 1.4 by jmc, Tue Mar 27 15:49:37 2012 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "FIZHI_OPTIONS.h"  #include "FIZHI_OPTIONS.h"
5         subroutine fizhi_init_vars (myThid)         SUBROUTINE FIZHI_INIT_VARS (myThid)
6  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
7  c  Routine to initialise the fizhi state.  c  Routine to initialise the fizhi state.
8  c    c
9  c  Input: myThid       - Process number calling this routine  c  Input: myThid       - Process number calling this routine
10  c  c
11  c  Notes:  c  Notes:
12  c   1) For a Cold Start -  c   1) For a Cold Start -
13  c      This routine takes the initial condition on the dynamics grid  c      This routine takes the initial condition on the dynamics grid
14  c      and interpolates to the physics grid to initialize the state  c      and interpolates to the physics grid to initialize the state
15  c      variables that are on both grids. It initializes the variables  c      variables that are on both grids. It initializes the variables
# Line 20  c   3) The velocity component physics fi Line 20  c   3) The velocity component physics fi
20  c  c
21  c Calls: dyn2phys (x4)  c Calls: dyn2phys (x4)
22  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
23         implicit none         IMPLICIT NONE
24  #include "SIZE.h"  #include "SIZE.h"
25  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
26  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
# Line 35  c--------------------------------------- Line 35  c---------------------------------------
35  #include "PARAMS.h"  #include "PARAMS.h"
36  #include "chronos.h"  #include "chronos.h"
37    
38         integer myThid         INTEGER myThid
39    
40  c pe on dynamics and physics grid refers to bottom edge  c pe on dynamics and physics grid refers to bottom edge
41         _RL pephy(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nrphys+1,nSx,nSy)         _RL pephy(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nrphys+1,nSx,nSy)
# Line 45  c pe on dynamics and physics grid refers Line 45  c pe on dynamics and physics grid refers
45         _RL vdyntemp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)         _RL vdyntemp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
46         _RL tempphy(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nrphys,nSx,nSy)         _RL tempphy(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nrphys,nSx,nSy)
47    
48         integer i, j, L, bi, bj, Lbotij         INTEGER i, j, L, bi, bj, Lbotij
49         integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2         INTEGER im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
50         logical alarm         LOGICAL alarm
51         external alarm         EXTERNAL alarm
52    
53         im1 = 1-OLx         im1 = 1-OLx
54         im2 = sNx+OLx         im2 = sNx+OLx
# Line 63  c   First Check to see if we can start a Line 63  c   First Check to see if we can start a
63  c    All Fizhi alarms must be on for the first time step of a segment  c    All Fizhi alarms must be on for the first time step of a segment
64    
65        if( .not.alarm('moist') .or. .not.alarm('turb')   .or.        if( .not.alarm('moist') .or. .not.alarm('turb')   .or.
66       .    .not.alarm('radsw') .or. .not.alarm('radlw') ) then       &    .not.alarm('radsw') .or. .not.alarm('radlw') ) then
67         print *,' Cant Start Fizhi experiment at ',nymd,' ',nhms         print *,' Cant Start Fizhi experiment at ',nymd,' ',nhms
68         stop         stop
69        endif        endif
# Line 86  C Build pressures on dynamics grid Line 86  C Build pressures on dynamics grid
86          enddo          enddo
87          do j = 1,sNy          do j = 1,sNy
88          do i = 1,sNx          do i = 1,sNx
89           Lbotij = ksurfC(i,j,bi,bj)           Lbotij = kSurfC(i,j,bi,bj)
90           if(Lbotij.ne.0.)           if(Lbotij.ne.0.)
91       .    pedyn(i,j,Lbotij,bi,bj) = Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)       &    pedyn(i,j,Lbotij,bi,bj) = Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)
92          enddo          enddo
93          enddo          enddo
94          do j = 1,sNy          do j = 1,sNy
95          do i = 1,sNx          do i = 1,sNx
96           Lbotij = ksurfC(i,j,bi,bj)           Lbotij = kSurfC(i,j,bi,bj)
97           do L = Lbotij+1,Nr+1           do L = Lbotij+1,Nr+1
98            pedyn(i,j,L,bi,bj) = pedyn(i,j,L-1,bi,bj) -            pedyn(i,j,L,bi,bj) = pedyn(i,j,L-1,bi,bj) -
99       .                        drF(L-1)*hfacC(i,j,L-1,bi,bj)       &                        drF(L-1)*hfacC(i,j,L-1,bi,bj)
100           enddo           enddo
101  c Do not use a zero field as the top edge pressure for interpolation  c Do not use a zero field as the top edge pressure for interpolation
102           if(pedyn(i,j,Nr+1,bi,bj).lt.1.e-5)           if(pedyn(i,j,Nr+1,bi,bj).lt.1.e-5)
103       .                               pedyn(i,j,Nr+1,bi,bj) = 1.e-5       &                               pedyn(i,j,Nr+1,bi,bj) = 1.e-5
104          enddo          enddo
105          enddo          enddo
106  C Build pressures on physics grid  C Build pressures on physics grid
# Line 112  C Build pressures on physics grid Line 112  C Build pressures on physics grid
112           enddo           enddo
113  c Do not use a zero field as the top edge pressure for interpolation  c Do not use a zero field as the top edge pressure for interpolation
114           if(pephy(i,j,Nrphys+1,bi,bj).lt.1.e-5)           if(pephy(i,j,Nrphys+1,bi,bj).lt.1.e-5)
115       .                               pephy(i,j,Nrphys+1,bi,bj) = 1.e-5       &                               pephy(i,j,Nrphys+1,bi,bj) = 1.e-5
116          enddo          enddo
117          enddo          enddo
118  c  c
# Line 123  c   do units and get u = .025*ln(dP*10), Line 123  c   do units and get u = .025*ln(dP*10),
123          do j = 1,sNy          do j = 1,sNy
124          do i = 1,sNx          do i = 1,sNx
125           windphy(i,j,L,bi,bj) = 0.025 *           windphy(i,j,L,bi,bj) = 0.025 *
126       .             log((pephy(i,j,1,bi,bj)-pephy(i,j,L+1,bi,bj))*10.)       &             log((pephy(i,j,1,bi,bj)-pephy(i,j,L+1,bi,bj))*10.)
127          enddo          enddo
128          enddo          enddo
129          enddo          enddo
130    
131         enddo         enddo
132         enddo         enddo
133                                                                                      
134  c Create initial fields on phys. grid - Move Dynamics u and v to A-Grid  c Create initial fields on phys. grid - Move Dynamics u and v to A-Grid
135         call CtoA(myThid,uvel,vvel,maskW,maskS,im1,im2,jm1,jm2,Nr,         call CtoA(myThid,uvel,vvel,maskW,maskS,im1,im2,jm1,jm2,Nr,
136       .                     Nsx,Nsy,1,sNx,1,sNy,udyntemp,vdyntemp)       &                     nSx,nSy,1,sNx,1,sNy,udyntemp,vdyntemp)
137    
138         do bj = myByLo(myThid), myByHi(myThid)         do bj = myByLo(myThid), myByHi(myThid)
139         do bi = myBxLo(myThid), myBxHi(myThid)         do bi = myBxLo(myThid), myBxHi(myThid)
140    
141  c Create initial fields on phys. grid - interpolate from dyn. grid  c Create initial fields on phys. grid - interpolate from dyn. grid
142          call dyn2phys(udyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,          call dyn2phys(udyntemp,pedyn,im1,im2,jm1,jm2,Nr,nSx,nSy,
143       . 1,sNx,1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,1,tempphy)       & 1,sNx,1,sNy,bi,bj,windphy,pephy,kSurfC,Nrphys,nlperdyn,1,tempphy)
144  c   Note: Interpolation gives bottom-up arrays (level 1 is bottom),  c   Note: Interpolation gives bottom-up arrays (level 1 is bottom),
145  c         Physics works top-down. so -> need to flip arrays  c         Physics works top-down. so -> need to flip arrays
146          do L = 1,Nrphys          do L = 1,Nrphys
# Line 150  c         Physics works top-down. so -> Line 150  c         Physics works top-down. so ->
150          enddo          enddo
151          enddo          enddo
152          enddo          enddo
153          call dyn2phys(vdyntemp,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,          call dyn2phys(vdyntemp,pedyn,im1,im2,jm1,jm2,Nr,nSx,nSy,
154       . 1,sNx,1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,1,tempphy)       & 1,sNx,1,sNy,bi,bj,windphy,pephy,kSurfC,Nrphys,nlperdyn,1,tempphy)
155          do L = 1,Nrphys          do L = 1,Nrphys
156          do j = 1,sNy          do j = 1,sNy
157          do i = 1,sNx          do i = 1,sNx
# Line 159  c         Physics works top-down. so -> Line 159  c         Physics works top-down. so ->
159          enddo          enddo
160          enddo          enddo
161          enddo          enddo
162          call dyn2phys(theta,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,          call dyn2phys(theta,pedyn,im1,im2,jm1,jm2,Nr,nSx,nSy,
163       . 1,sNx,1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,0,tempphy)       & 1,sNx,1,sNy,bi,bj,windphy,pephy,kSurfC,Nrphys,nlperdyn,0,tempphy)
164          do L = 1,Nrphys          do L = 1,Nrphys
165          do j = 1,sNy          do j = 1,sNy
166          do i = 1,sNx          do i = 1,sNx
# Line 169  c         Physics works top-down. so -> Line 169  c         Physics works top-down. so ->
169          enddo          enddo
170          enddo          enddo
171    
172          call dyn2phys(salt,pedyn,im1,im2,jm1,jm2,Nr,Nsx,Nsy,          call dyn2phys(salt,pedyn,im1,im2,jm1,jm2,Nr,nSx,nSy,
173       . 1,sNx,1,sNy,bi,bj,windphy,pephy,ksurfC,Nrphys,nlperdyn,0,tempphy)       & 1,sNx,1,sNy,bi,bj,windphy,pephy,kSurfC,Nrphys,nlperdyn,0,tempphy)
174          do L = 1,Nrphys          do L = 1,Nrphys
175          do j = 1,sNy          do j = 1,sNy
176          do i = 1,sNx          do i = 1,sNx
# Line 223  c Initialize vegetation tile tke, xlmt, Line 223  c Initialize vegetation tile tke, xlmt,
223           print *,' Need initial Values for TKE - dont have them! '           print *,' Need initial Values for TKE - dont have them! '
224           stop           stop
225          endif          endif
226            turbStart(bi,bj) = .TRUE.
227    
228  c Now initialize vegetation tile land state too - tcanopy, etc...  c Now initialize vegetation tile land state too - tcanopy, etc...
229  c       call fizhi_init_vegsurftiles( nymd,nhms, 'D', myThid )  c       call fizhi_init_vegsurftiles( nymd,nhms, 'D', myThid )
230  c Now initialize land state too - tcanopy, etc... SET FOR NOW,  c Now initialize land state too - tcanopy, etc... SET FOR NOW,
231  c                                              READ CLIM FOR REAL  c                                              READ CLIM FOR REAL
# Line 279  c Now initialize fizhi arrays that will Line 280  c Now initialize fizhi arrays that will
280    
281        ELSE        ELSE
282        print *,' In fizhi_init_vars: Read from restart '        print *,' In fizhi_init_vars: Read from restart '
283                                                                                      
284  C--   Read fizhi package state variables from pickup file  C--   Read fizhi package state variables from pickup file
285    
286         call fizhi_read_pickup( nIter0, myThid )         call fizhi_read_pickup( nIter0, myThid )
287         CALL FIZHI_READ_VEGTILES( nIter0, 'D', myThid )         CALL FIZHI_READ_VEGTILES( nIter0, 'D', myThid )
288           do bj = myByLo(myThid), myByHi(myThid)
289           do bi = myBxLo(myThid), myBxHi(myThid)
290             turbStart(bi,bj) = .FALSE.
291           enddo
292           enddo
293    
294        ENDIF        ENDIF
295    
296         return        RETURN
297         end        END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22