/[MITgcm]/MITgcm/compare01/src/update_w.F
ViewVC logotype

Contents of /MITgcm/compare01/src/update_w.F

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


Revision 1.1 - (show annotations) (download)
Mon May 25 20:21:06 1998 UTC (26 years, 1 month ago) by cnh
Branch: MAIN
CVS Tags: branch-atmos-merge-phase6, checkpoint24, checkpoint4, checkpoint7, checkpoint6, checkpoint26, checkpoint3, branch-atmos-merge-start, checkpoint27, checkpoint9, checkpoint8, checkpoint11, checkpoint10, checkpoint13, checkpoint12, checkpoint15, checkpoint18, checkpoint17, checkpoint16, checkpoint19, checkpoint32, checkpoint31, branch-atmos-merge-zonalfilt, branch-atmos-merge-shapiro, checkpoint5, branch-atmos-merge-freeze, branch-point-rdot, checkpoint14, checkpoint28, checkpoint29, branch-atmos-merge-phase5, branch-atmos-merge-phase4, branch-atmos-merge-phase7, checkpoint23, branch-atmos-merge-phase1, checkpoint25, branch-atmos-merge-phase3, branch-atmos-merge-phase2, checkpoint20, checkpoint21, checkpoint22
Branch point for: branch-atmos-merge, checkpoint7-4degree-ref, branch-rdot
Added version of compare01 reference code to repository.
Code committed is configured to produce same results as MITgcmUV

1 C $Id: update_w.F,v 1.5 1997/06/03 15:03:29 cnh Exp $
2 #include "CPP_OPTIONS.h"
3 #include "CPP_MACROS.h"
4 C/-------------------------------------------------------------------\
5 C||| Procedure: UPDATE_W |||
6 C|||===============================================================|||
7 C||| Function: Step forward W. |||
8 C||| Comments: |||
9 C\-------------------------------------------------------------------/
10 CStartofinterface
11 SUBROUTINE UPDATE_W(
12 I U, V, PS,
13 O W )
14 IMPLICIT NONE
15 C /--------------------------------------------------------------\
16 C | Global data |
17 C |==============================================================|
18 C \--------------------------------------------------------------/
19 #include "SIZE.h"
20 #include "AJAINF.h"
21 #include "OPERATORS.h"
22 #include "GRID.h"
23 #include "PARAMS.h"
24 #include "OLDG.h"
25 #include "MASKS.h"
26 C /--------------------------------------------------------------\
27 C | Routine arguments |
28 C |==============================================================|
29 C | U, V, W - X,Y,Z Velocity ( m/s, m/s, Pa/s ). |
30 C | PS - Surface pressure (m). |
31 C \--------------------------------------------------------------/
32 REAL U (Nx,Ny,Nz)
33 REAL V (Nx,Ny,Nz)
34 REAL PS(Nx,Ny )
35 REAL W (Nx,Ny,Nz)
36 CEndofinterface
37 C /--------------------------------------------------------------\
38 C | Local variables |
39 C |==============================================================|
40 C | I,J,K - Loop counters. |
41 C | tmp - Work array. |
42 C \--------------------------------------------------------------/
43 REAL tmp(0:Nx+1,0:Ny+1)
44 INTEGER I
45 INTEGER J
46 INTEGER K
47 C
48 W = 0.
49 C
50 DO K = Nz, 1, -1
51 tmp(1:Nx,1:Ny) = U(_I3(K,:,:))*XA(_I3(K,:,:))
52 tmp(Nx+1,1:Ny) = tmp(1,1:Ny)
53 DO J=1,Ny
54 DO I=1,Nx
55 W(_I3(K,I,J)) = ( tmp(I+1,J)-tmp(I,J) )
56 ENDDO
57 ENDDO
58 tmp(1:Nx,1:Ny) = V(_I3(K,:,:))*YA(_I3(K,:,:))
59 tmp(1:Nx,Ny+1) = tmp(1:Nx,1)
60 DO J=1,Ny
61 DO I=1,Nx
62 W(_I3(K,I,J)) = W(_I3(K,I,J))+( tmp(I,J+1)-tmp(I,J) )
63 ENDDO
64 ENDDO
65 IF ( K .NE. Nz ) THEN
66 DO J=1,Ny
67 DO I=1,Nx
68 W(_I3(K,I,J)) = W(_I3(K,I,J)) + W(_I3(K+1,I,J))*ZA(_I3(K+1,I,J))
69 ENDDO
70 ENDDO
71 ENDIF
72 DO J=1,Ny
73 DO I=1,Nx
74 IF ( ZA(_I3(K,I,J)) .NE. 0. ) THEN
75 W(_I3(K,I,J)) = W(_I3(K,I,J))/ZA(_I3(K,I,J))
76 ELSE
77 W(_I3(K,I,J)) = 0.
78 ENDIF
79 ENDDO
80 ENDDO
81 ENDDO
82
83 C Rigid lid
84 IF ( freeSurfFac .EQ. 0. ) W(_I3(1,:,:)) = 0.
85 C
86 C _D(( ' S/R UPDATE_W: MAXVAL(W) = ',MAXVAL(W) ))
87 RETURN
88 END

  ViewVC Help
Powered by ViewVC 1.1.22