/[MITgcm]/MITgcm_contrib/plumes/plume2dyn.F
ViewVC logotype

Diff of /MITgcm_contrib/plumes/plume2dyn.F

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

revision 1.2 by molod, Tue May 25 18:08:51 2004 UTC revision 1.4 by molod, Wed May 26 03:10:27 2004 UTC
# Line 1  Line 1 
1        subroutine plume2dyn(qplume,Nxplume,Lmplume,uref,vref,flag,        subroutine plume2dyn(qplume,Nxplume,Lmplume,uref,vref,flag,
2       .     idim1,idim2,jdim1,jdim2,Lmout,Nsx,Nsy,bi,bj,qdyn1,qdyn2)       . idim1,idim2,jdim1,jdim2,i1,i2,j1,j2,Nsx,Nsy,bi,bj,qdyn1,qdyn2)
3  C***********************************************************************  C***********************************************************************
4  C Purpose:  C Purpose:
5  C   To interpolate an arbitrary quantity from higher resolution plume  C   To interpolate an arbitrary quantity from higher resolution plume
# Line 11  C             given in (uref,vref) Line 11  C             given in (uref,vref)
11  C  C
12  C Input:  C Input:
13  C   qplume... [idim2,jdim2,im,Lmplume,bi] Quantity on Input Grid  C   qplume... [idim2,jdim2,im,Lmplume,bi] Quantity on Input Grid
14  C   idimin... Longitude Dimension of Input  C   Nxplume . Longitude Dimension of Input
15  C   Lmplume.. Vertical  Dimension of Input  C   Lmplume.. Vertical  Dimension of Input
16  C   uref .... [im,jm,Lmout,bi,bj] Reference u-component of velocity  C   uref .... [im,jm,Lmplume,bi,bj] Reference u-component of velocity
17  C   vref .... [im,jm,Lmout,bi,bj] Reference v-component of velocity  C   vref .... [im,jm,plume,bi,bj] Reference v-component of velocity
18  C   flag .... Flag to indicate vector (1) or scalar (0) interpolation  C   flag .... Flag to indicate vector (1) or scalar (0) interpolation
19  C   idim1,2.. Beginning and ending i-values of output grid  C   idim1,2.. Beginning and ending dimension of output grid
20  C   jdim1,2.. Beginning and ending j-values of output grid  C   jdim1,2.. Beginning and ending dimension of output grid
21  C   Lmout.... Vertical  Dimension of Output  C   i1,2..... Beginning and ending x-direction span        
22    C   j1,2..... Beginning and ending y-direction span        
23  C   Nsx...... Number of processes in x-direction  C   Nsx...... Number of processes in x-direction
24  C   Nsy...... Number of processes in y-direction  C   Nsy...... Number of processes in y-direction
25  C   bi....... Index of process number in x-direction  C   bi....... Index of process number in x-direction
26  C   bj....... Index of process number in x-direction  C   bj....... Index of process number in x-direction
27  C  C
28  C Output:  C Output:
29  C   qdyn1..... [im,jm,Lmout,bi,bj] Field at output grid (dynamics)  C   qdyn1..... [im,jm,plume,bi,bj] Field at output grid (dynamics)
30  C   qdyn2..... [im,jm,Lmout,bi,bj] Field at output grid (dynamics)  C   qdyn2..... [im,jm,plume,bi,bj] Field at output grid (dynamics)
31  C  C
32  C Notes:  C Notes:
33  C   1)  Assume (for now) that the number of vertical levels is the  C   1)  Assume (for now) that the number of vertical levels is the
# Line 35  C*************************************** Line 36  C***************************************
36        implicit none        implicit none
37  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
38    
39        integer  Nxplume, Lmplume, Lmout, Nsx, Nsy        integer  Nxplume, Lmplume, Nsx, Nsy
40        integer idim1, idim2, jdim1, jdim2, bi, bj, flag        integer idim1, idim2, jdim1, jdim2, i1, i2, j1, j2
41        _RL qplume(idim2,jdim2,Nxplume,Lmplume,Nsx)        integer bi, bj, flag
42        _RL uref(idim1:idim2,jdim1:jdim2,Lmout,Nsx,Nsy)        _RL qplume(i2,j2,Nxplume,Lmplume,Nsx)
43        _RL vref(idim1:idim2,jdim1:jdim2,Lmout,Nsx,Nsy)        _RL uref(idim1:idim2,jdim1:jdim2,Lmplume,Nsx,Nsy)
44        _RL qdyn1(idim1:idim2,jdim1:jdim2,Lmout,Nsx,Nsy)        _RL vref(idim1:idim2,jdim1:jdim2,Lmplume,Nsx,Nsy)
45        _RL qdyn2(idim1:idim2,jdim1:jdim2,Lmout,Nsx,Nsy)        _RL qdyn1(idim1:idim2,jdim1:jdim2,Lmplume,Nsx,Nsy)
46          _RL qdyn2(idim1:idim2,jdim1:jdim2,Lmplume,Nsx,Nsy)
47    
48        integer i,j,L,iplume        integer i,j,L,iplume
49        _RL qplumeav(idim1,jdim2,Lmplume)        _RL qplumeav(i1,j2,Lmplume)
50        _RL sqrtarg        _RL sqrtarg
51    
52  C First step - compute the average of qplume over Nxplume  C First step - compute the average of qplume over Nxplume
53        do j = jdim1,jdim2        do j = j1,j2
54        do i = idim1,idim2        do i = i1,i2
55         do L = 1,Lmplume         do L = 1,Lmplume
56          qplumeav(i,j,L) = 0.          qplumeav(i,j,L) = 0.
57          do iplume = 1,Nxplume          do iplume = 1,Nxplume
# Line 65  C If a vector, there is some more work t Line 67  C If a vector, there is some more work t
67  C the angle given by uref and vref  C the angle given by uref and vref
68    
69        if (flag.eq.0) then        if (flag.eq.0) then
70         do j = jdim1,jdim2         do j = j1,j2
71         do i = idim1,idim2         do i = i1,i2
72         do L = 1,Lmplume         do L = 1,Lmplume
73          qdyn1(i,j,L,bi,bj) = qplumeav(i,j,L)          qdyn1(i,j,L,bi,bj) = qplumeav(i,j,L)
74         enddo         enddo
75         enddo         enddo
76         enddo         enddo
77        elseif (flag.eq.1) then        elseif (flag.eq.1) then
78         do j = jdim1,jdim2         do j = j1,j2
79         do i = idim1,idim2         do i = i1,i2
80         do L = 1,Lmplume         do L = 1,Lmplume
81          sqrtarg = (qplumeav(i,j,L)*qplumeav(i,j,L)) /          if(vref(i,j,L,bi,bj).ne.0.) then
82             sqrtarg = (qplumeav(i,j,L)*qplumeav(i,j,L)) /
83       .  ( ( (uref(i,j,L,bi,bj)*uref(i,j,L,bi,bj)) /       .  ( ( (uref(i,j,L,bi,bj)*uref(i,j,L,bi,bj)) /
84       .      (vref(i,j,L,bi,bj)*vref(i,j,L,bi,bj)) ) + 1. )       .      (vref(i,j,L,bi,bj)*vref(i,j,L,bi,bj)) ) + 1. )
85          qdyn2(i,j,L,bi,bj) = sqrt(sqrtarg)           qdyn2(i,j,L,bi,bj) = sqrt(sqrtarg)
86          qdyn1(i,j,L,bi,bj) = qdyn2(i,j,L,bi,bj) *           qdyn1(i,j,L,bi,bj) = qdyn2(i,j,L,bi,bj) *
87       .                            (uref(i,j,L,bi,bj)/vref(i,j,L,bi,bj))       .                            (uref(i,j,L,bi,bj)/vref(i,j,L,bi,bj))
88            else
89             qdyn1(i,j,L,bi,bj) = qplumeav(i,j,L)
90             qdyn2(i,j,L,bi,bj) = 0.
91         enddo         enddo
92         enddo         enddo
93         enddo         enddo
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22