/[MITgcm]/MITgcm/pkg/fizhi/fizhi_utils.F
ViewVC logotype

Diff of /MITgcm/pkg/fizhi/fizhi_utils.F

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

revision 1.8 by molod, Fri Jul 23 22:32:28 2004 UTC revision 1.9 by molod, Mon Jul 26 18:45:17 2004 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "FIZHI_OPTIONS.h"
5        function minval (q,im)        function minval (q,im)
6        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
7        integer  im, i        integer  im, i
8        real q(im), minval        _RL q(im), minval
9        minval = 1.e15        minval = 1.e15
10        do i=1,im        do i=1,im
11        if( q(i).lt.minval ) minval = q(i)        if( q(i).lt.minval ) minval = q(i)
# Line 23  C        USED TO COMPUTE FRACTIONAL CLOU Line 26  C        USED TO COMPUTE FRACTIONAL CLOU
26  C          FROM TURBULENCE STATISTICS  C          FROM TURBULENCE STATISTICS
27  C **********************************************************************  C **********************************************************************
28        implicit none        implicit none
29        real arg,errf        _RL arg,errf
30    
31        real aa1,aa2,aa3,aa4,aa5,pp,x2,x3,x4,x5        _RL aa1,aa2,aa3,aa4,aa5,pp,x2,x3,x4,x5
32        PARAMETER ( AA1  =   0.254829592 )        PARAMETER ( AA1  =   0.254829592 )
33        PARAMETER ( AA2  =  -0.284496736 )        PARAMETER ( AA2  =  -0.284496736 )
34        PARAMETER ( AA3  =   1.421413741 )        PARAMETER ( AA3  =   1.421413741 )
# Line 37  C ************************************** Line 40  C **************************************
40        PARAMETER ( X4   =   AA5 / AA3   )        PARAMETER ( X4   =   AA5 / AA3   )
41        PARAMETER ( X5   =   AA5 / AA4   )        PARAMETER ( X5   =   AA5 / AA4   )
42    
43        real aarg,tt        _RL aarg,tt
44                
45        ERRF = 1.        ERRF = 1.
46        AARG=ABS(ARG)        AARG=ABS(ARG)
# Line 56  C ************************************** Line 59  C **************************************
59    
60        SUBROUTINE STRIP(A,B,IA,IB,L,K)                                                  SUBROUTINE STRIP(A,B,IA,IB,L,K)                                          
61        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
62        integer ia,ib,L,K        integer ia,ib,L,K
63        real A(IA,L), B(IB,L)                                                        _RL A(IA,L), B(IB,L)                                                
64                
65        INTEGER OFFSET,Len,i,j        INTEGER OFFSET,Len,i,j
66                                                                                                                                                                    
# Line 86  C ************************************** Line 88  C **************************************
88        END                                                                              END                                                                      
89        SUBROUTINE PASTE(B,A,IB,IA,L,K)                                                  SUBROUTINE PASTE(B,A,IB,IA,L,K)                                          
90        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
91        integer ia,ib,L,K        integer ia,ib,L,K
92        real A(IA,L), B(IB,L)                                                        _RL A(IA,L), B(IB,L)                                                
93    
94        INTEGER OFFSET,LEN,i,j        INTEGER OFFSET,LEN,i,j
95                                                                                                                                                                    
# Line 105  C ************************************** Line 106  C **************************************
106        END                                                                              END                                                                      
107        SUBROUTINE PSTBMP(B,A,IB,IA,L,K)                                                  SUBROUTINE PSTBMP(B,A,IB,IA,L,K)                                          
108        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
109        integer ia,ib,L,K        integer ia,ib,L,K
110        real A(IA,L), B(IB,L)                                                        _RL A(IA,L), B(IB,L)                                                
111    
112        INTEGER OFFSET,LEN,i,j        INTEGER OFFSET,LEN,i,j
113                                                                                                                                                                    
# Line 173  C Line 173  C
173  C***********************************************************************  C***********************************************************************
174    
175        IMPLICIT NONE        IMPLICIT NONE
176  #include "CPP_EEOPTIONS.h"        _RL TT, P, Q, DQDT
       real TT, P, Q, DQDT  
177        LOGICAL LDQDT        LOGICAL LDQDT
178    
179        real AIRMW, H2OMW        _RL AIRMW, H2OMW
180                
181        PARAMETER ( AIRMW  = 28.97      )                                                PARAMETER ( AIRMW  = 28.97      )                                        
182        PARAMETER ( H2OMW  = 18.01      )                                                PARAMETER ( H2OMW  = 18.01      )                                        
183    
184        real ESFAC, ERFAC        _RL ESFAC, ERFAC
185        PARAMETER ( ESFAC = H2OMW/AIRMW       )        PARAMETER ( ESFAC = H2OMW/AIRMW       )
186        PARAMETER ( ERFAC = (1.0-ESFAC)/ESFAC )        PARAMETER ( ERFAC = (1.0-ESFAC)/ESFAC )
187    
188        real aw0, aw1, aw2, aw3, aw4, aw5, aw6        _RL aw0, aw1, aw2, aw3, aw4, aw5, aw6
189        real bw0, bw1, bw2, bw3, bw4, bw5, bw6        _RL bw0, bw1, bw2, bw3, bw4, bw5, bw6
190        real ai0, ai1, ai2, ai3, ai4, ai5, ai6        _RL ai0, ai1, ai2, ai3, ai4, ai5, ai6
191        real bi0, bi1, bi2, bi3, bi4, bi5, bi6        _RL bi0, bi1, bi2, bi3, bi4, bi5, bi6
192    
193        real d0, d1, d2, d3, d4, d5, d6        _RL d0, d1, d2, d3, d4, d5, d6
194        real e0, e1, e2, e3, e4, e5, e6        _RL e0, e1, e2, e3, e4, e5, e6
195        real f0, f1, f2, f3, f4, f5, f6        _RL f0, f1, f2, f3, f4, f5, f6
196        real g0, g1, g2, g3, g4, g5, g6        _RL g0, g1, g2, g3, g4, g5, g6
197    
198  c ********************************************************  c ********************************************************
199  c ***  Polynomial Coefficients WRT Water (Lowe, 1977) ****  c ***  Polynomial Coefficients WRT Water (Lowe, 1977) ****
# Line 284  c ************************************** Line 283  c **************************************
283        parameter ( g5 = 0.262430726e-09 * esfac )        parameter ( g5 = 0.262430726e-09 * esfac )
284        parameter ( g6 = 0.481960676e-12 * esfac )        parameter ( g6 = 0.481960676e-12 * esfac )
285    
286        real TMAX, TICE        _RL TMAX, TICE
287        PARAMETER ( TMAX=323.15, TICE=273.16)        PARAMETER ( TMAX=323.15, TICE=273.16)
288                
289        real T, D, W, QX, DQX        _RL T, D, W, QX, DQX
290        T = MIN(TT,TMAX) - TICE        T = MIN(TT,TMAX) - TICE
291        DQX = 0.        DQX = 0.
292        QX  = 0.        QX  = 0.
# Line 346  c ------------------------------------ Line 345  c ------------------------------------
345        END        END
346        subroutine vqsat (tt,p,q,dqdt,ldqdt,n)        subroutine vqsat (tt,p,q,dqdt,ldqdt,n)
347        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
348        integer  i,n        integer  i,n
349        logical  ldqdt        logical  ldqdt
350        real tt(n), p(n), q(n), dqdt(n)        _RL tt(n), p(n), q(n), dqdt(n)
351  #ifdef CRAY  #ifdef CRAY
352  #ifdef f77  #ifdef f77
353  cfpp$ expand (qsat)  cfpp$ expand (qsat)
# Line 363  cfpp$ expand (qsat) Line 361  cfpp$ expand (qsat)
361    
362        subroutine stripit(a,b,irun,ia,ib,l,k)        subroutine stripit(a,b,irun,ia,ib,l,k)
363        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
364        integer ia,ib,irun,l,k        integer ia,ib,irun,l,k
365        real a(ia,l), b(ib,l)        _RL a(ia,l), b(ib,l)
366        integer   i,j,len,offset        integer   i,j,len,offset
367    
368        offset = ib*(k-1)        offset = ib*(k-1)
# Line 392  cfpp$ expand (qsat) Line 389  cfpp$ expand (qsat)
389    
390        subroutine stripitint(a,b,irun,ia,ib,l,k)        subroutine stripitint(a,b,irun,ia,ib,l,k)
391        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
392        integer ia,ib,irun,l,k,a(ia,l),b(ib,l)        integer ia,ib,irun,l,k,a(ia,l),b(ib,l)
393        integer i,j,len,offset        integer i,j,len,offset
394    
# Line 420  cfpp$ expand (qsat) Line 416  cfpp$ expand (qsat)
416    
417        subroutine pastit(b,a,ib,ia,irun,L,k)        subroutine pastit(b,a,ib,ia,irun,L,k)
418        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
419        integer ib,ia,L,k,irun,len,offset        integer ib,ia,L,k,irun,len,offset
420        integer i,j        integer i,j
421        real a(ia,l), b(ib,l)        _RL a(ia,l), b(ib,l)
422    
423        offset = ib*(k-1)        offset = ib*(k-1)
424        len    = min(ib,irun-offset)        len    = min(ib,irun-offset)
# Line 438  cfpp$ expand (qsat) Line 433  cfpp$ expand (qsat)
433    
434        subroutine pstbitint(b,a,ib,ia,irun,l,k)        subroutine pstbitint(b,a,ib,ia,irun,l,k)
435        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
436        integer ib,ia,L,k,irun,len,offset        integer ib,ia,L,k,irun,len,offset
437        real a(ia,l)        _RL a(ia,l)
438        integer b(ib,l)        integer b(ib,l)
439        integer i,j        integer i,j
440    
# Line 458  cfpp$ expand (qsat) Line 452  cfpp$ expand (qsat)
452    
453        subroutine pstbmpit(b,a,ib,ia,irun,l,k)        subroutine pstbmpit(b,a,ib,ia,irun,l,k)
454        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
455        integer ib,ia,L,k,irun,len,offset        integer ib,ia,L,k,irun,len,offset
456        real a(ia,l), b(ib,l)        _RL a(ia,l), b(ib,l)
457        integer i,j        integer i,j
458    
459        offset = ib*(k-1)        offset = ib*(k-1)
# Line 494  c output: Line 487  c output:
487  c      b      - array to be filled, ie, one processors field [ib,levs]  c      b      - array to be filled, ie, one processors field [ib,levs]
488  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
489        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
490        integer ia,ib,irun,levs,npeice        integer ia,ib,irun,levs,npeice
491        real a(ia,levs), b(ib,levs)        _RL a(ia,levs), b(ib,levs)
492        integer index(irun)        integer index(irun)
493        integer i,k,len,offset        integer i,k,len,offset
494    
# Line 549  c within a parallel region. Line 541  c within a parallel region.
541  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
542    
543        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
544        integer ia,ib,levs,numpts,npeice        integer ia,ib,levs,numpts,npeice
545        integer index(numpts)        integer index(numpts)
546        real a(ia,levs), b(ib,levs), chfr(ib)        _RL a(ia,levs), b(ib,levs), chfr(ib)
547    
548        integer i,L,offset,len        integer i,L,offset,len
549    
# Line 596  c within a parallel region. Line 587  c within a parallel region.
587  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
588    
589        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
590        integer ia,ib,levs,numpts,npeice        integer ia,ib,levs,numpts,npeice
591        integer index(numpts)        integer index(numpts)
592        real a(ia,levs), b(ib,levs), chfr(ib)        _RL a(ia,levs), b(ib,levs), chfr(ib)
593        logical check        logical check
594    
595        integer i,L,offset,len        integer i,L,offset,len
596        real    undef,getcon        _RL    undef,getcon
597    
598        offset = ib*(npeice-1)        offset = ib*(npeice-1)
599        len    = min(ib,numpts-offset)        len    = min(ib,numpts-offset)
# Line 633  c--------------------------------------- Line 623  c---------------------------------------
623        SUBROUTINE GRD2MSC(A,IM,JM,IGRD,B,MXCHPS,NCHP)        SUBROUTINE GRD2MSC(A,IM,JM,IGRD,B,MXCHPS,NCHP)
624    
625        implicit none        implicit none
 #include "CPP_EEOPTIONS.h"  
626        integer im,jm,mxchps,nchp        integer im,jm,mxchps,nchp
627        integer igrd(mxchps)        integer igrd(mxchps)
628        real A(IM,JM), B(MXCHPS)        _RL A(IM,JM), B(MXCHPS)
629    
630        integer i        integer i
631    
# Line 654  c--------------------------------------- Line 643  c---------------------------------------
643        SUBROUTINE MSC2GRD(IGRD,CHFR,B,MXCHPS,NCHP,FRACG,A,IM,JM)        SUBROUTINE MSC2GRD(IGRD,CHFR,B,MXCHPS,NCHP,FRACG,A,IM,JM)
644    
645        implicit none        implicit none
646  #include "CPP_EEOPTIONS.h"        _RL zero,one
       real zero,one  
647        parameter ( one = 1.)        parameter ( one = 1.)
648        parameter (zero = 0.)        parameter (zero = 0.)
649        integer im,jm,mxchps,nchp        integer im,jm,mxchps,nchp
650        integer igrd(mxchps)        integer igrd(mxchps)
651        real A(IM,JM), B(MXCHPS), CHFR(MXCHPS), FRACG(IM,JM)        _RL A(IM,JM), B(MXCHPS), CHFR(MXCHPS), FRACG(IM,JM)
652    
653        real VT1(IM,JM)        _RL VT1(IM,JM)
654        integer i        integer i
655    
656        print *,' In msc2grd ',(igrd(i),i=1,nchp)        print *,' In msc2grd ',(igrd(i),i=1,nchp)
# Line 693  c--------------------------------------- Line 681  c---------------------------------------
681       1       agrn,zoch,z2ch,cdrc,cdsc,sqsc,ufac,rsl1,rsl2,rdcs)       1       agrn,zoch,z2ch,cdrc,cdsc,sqsc,ufac,rsl1,rsl2,rdcs)
682    
683         implicit none         implicit none
 #include "CPP_EEOPTIONS.h"  
684    
685         integer nymd,nhms,nchp,mxchps,ityp(mxchps)         integer nymd,nhms,nchp,mxchps,ityp(mxchps)
686         real chlt(mxchps)         _RL chlt(mxchps)
687         real alai(mxchps),agrn(mxchps)         _RL alai(mxchps),agrn(mxchps)
688         real zoch(mxchps), z2ch(mxchps), cdrc(mxchps), cdsc(mxchps)         _RL zoch(mxchps), z2ch(mxchps), cdrc(mxchps), cdsc(mxchps)
689         real sqsc(mxchps), ufac(mxchps), rsl1(mxchps), rsl2(mxchps)         _RL sqsc(mxchps), ufac(mxchps), rsl1(mxchps), rsl2(mxchps)
690         real rdcs(mxchps)         _RL rdcs(mxchps)
691    
692  C*********************************************************************  C*********************************************************************
693  C********************* SUBROUTINE CHPPRM  ****************************  C********************* SUBROUTINE CHPPRM  ****************************
# Line 710  C*************************************** Line 697  C***************************************
697        integer ntyps        integer ntyps
698        parameter (ntyps=10)        parameter (ntyps=10)
699    
700        real pblzet        _RL pblzet
701        parameter (pblzet = 50.)        parameter (pblzet = 50.)
702        integer k1,k2,nymd1,nhms1,nymd2,nhms2,i        integer k1,k2,nymd1,nhms1,nymd2,nhms2,i
703        real getcon,vkrm,rootl,vroot,dum1,dum2,alphaf        _RL getcon,vkrm,rootl,vroot,dum1,dum2,alphaf
704        real facm,facp        _RL facm,facp
705        real scat,d        _RL scat,d
706    
707        real        _RL
708       &     vgdd(12, ntyps),    vgz0(12, ntyps),       &     vgdd(12, ntyps),    vgz0(12, ntyps),
709       &     vgrd(12, ntyps),    vgrt(12, ntyps),       &     vgrd(12, ntyps),    vgrt(12, ntyps),
710    
# Line 899  C*************************************** Line 886  C***************************************
886        implicit  none        implicit  none
887    
888        integer   im,jm,lm        integer   im,jm,lm
889        real      ple (im,jm,lm+1)        _RL ple(im,jm,lm+1)
890        real      pkle(im,jm,lm+1)        _RL pkle(im,jm,lm+1)
891        real      pkz (im,jm,lm)        _RL pkz(im,jm,lm)
892    
893        real akap1,getcon        _RL akap1,getcon
894        integer i,j,L        integer i,j,L
895    
896        akap1 = 1.0 + getcon('KAPPA')        akap1 = 1.0 + getcon('KAPPA')
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22