C $Header: /u/gcmpack/MITgcm/pkg/cheapaml/cheapaml_init_varia.F,v 1.16 2017/10/12 15:40:07 jmc Exp $
C $Name: $
#include "CHEAPAML_OPTIONS.h"
CBOP
C !ROUTINE: CHEAPAML_INIT_VARIA
C !INTERFACE:
SUBROUTINE CHEAPAML_INIT_VARIA( myThid )
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE CHEAPAML_INIT_VARIA
C | o Set cheapaml initial temp field
C *==========================================================*
C !USES:
IMPLICIT NONE
C === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "FFIELDS.h"
#include "CHEAPAML.h"
C !INPUT PARAMETERS:
C myThid :: my Thread Id number
INTEGER myThid
CEOP
C !FUNCTIONS
INTEGER ILNBLNK
EXTERNAL
C !LOCAL VARIABLES:
C bi,bj :: tile indices
C i,j :: grid-point indices
C msgBuf :: Informational/error message buffer
INTEGER bi, bj
INTEGER i, j
INTEGER iG,jG
_RL local, localt
_RL ssqa
_RL recipNym1
INTEGER iL, ioUnit
CHARACTER*(MAX_LEN_MBUF) msgBuf
C INTEGER prec
C CHARACTER*(MAX_LEN_FNAM) fn
ioUnit = standardMessageUnit
recipNym1 = Ny - 1
IF ( Ny.GT.1 ) recipNym1 = 1. _d 0 / recipNym1
C-- Initialise CheapAML variables in common block:
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
Tr (i,j,bi,bj) = 0. _d 0
qr (i,j,bi,bj) = 0. _d 0
Tair (i,j,bi,bj) = 0. _d 0
gTairm (i,j,bi,bj) = 0. _d 0
qair (i,j,bi,bj) = 0. _d 0
gqairm (i,j,bi,bj) = 0. _d 0
uWind (i,j,bi,bj) = 0. _d 0
vWind (i,j,bi,bj) = 0. _d 0
wWind (i,j,bi,bj) = 0. _d 0
solar (i,j,bi,bj) = 0. _d 0
ustress (i,j,bi,bj) = 0. _d 0
vstress (i,j,bi,bj) = 0. _d 0
wavesh (i,j,bi,bj) = 0. _d 0
wavesp (i,j,bi,bj) = 0. _d 0
cheapPrecip (i,j,bi,bj) = 0. _d 0
CheapHgrid (i,j,bi,bj) = 0. _d 0
c cheapPrGrid (i,j,bi,bj) = 0. _d 0
Cheapclouds (i,j,bi,bj) = 0. _d 0
Cheapdlongwave(i,j,bi,bj) = 0. _d 0
Cheaptracer (i,j,bi,bj) = 0. _d 0
CheaptracerR (i,j,bi,bj) = 0. _d 0
gCheaptracerm (i,j,bi,bj) = 0. _d 0
ENDDO
ENDDO
ENDDO
ENDDO
IF ( startTime.EQ.baseTime .AND. nIter0.EQ.0
& .AND. pickupSuff.EQ.' ' ) THEN
IF ( AirTempFile .NE. ' ' ) THEN
iL = ILNBLNK(AirTempFile)
WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
& 'Tair initialized from ->', AirTempFile(1:iL), '<-'
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
CALL READ_FLD_XY_RL( AirTempFile,' ',Tair,0,myThid )
ELSE
WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
& 'Tair initialized using standard profile'
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1,sNy
DO i=1,sNx
jG = myYGlobalLo-1+(bj-1)*sNy+j
iG = myXGlobalLo-1+(bi-1)*sNx+i
localt = 25. _d 0 - (jG-1)*recipNym1*10. _d 0
localt = 20. _d 0
& + 10. _d 0*EXP( -( (jG-30)**2+(iG-30)**2 )/100. _d 0 )
Tair(i,j,bi,bj) = localt
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
_EXCH_XY_RL( Tair, myThid )
C do specific humidity
IF ( AirQFile .NE. ' ') THEN
iL = ILNBLNK(AirQFile)
WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
& 'Qair initialized from ->', AirQFile(1:iL), '<-'
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
CALL READ_FLD_XY_RL( AirQFile,' ',qair,0,myThid )
ELSE
C default to 80% relative humidity
WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
& 'Qair initialized using standard profile'
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1,sNy
DO i=1,sNx
local= Tair(i,j,bi,bj)+celsius2K
ssqa = ssq0*EXP( lath*(ssq1-ssq2/local) ) / p0
qair(i,j,bi,bj)=0.8 _d 0*ssqa
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
_EXCH_XY_RL( qair, myThid )
C do passive tracer
IF ( TracerFile .NE. ' ') THEN
iL = ILNBLNK(TracerFile)
WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
& 'Tracer initialized from ->', TracerFile(1:iL), '<-'
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
CALL READ_FLD_XY_RL( TracerFile,' ',Cheaptracer,0,myThid )
ELSE
C default value at 290 (!)
WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
& 'Tracer initialized using standard profile'
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1,sNy
DO i=1,sNx
Cheaptracer(i,j,bi,bj)=290.0 _d 0
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
_EXCH_XY_RL( Cheaptracer, myThid )
ELSE
C Restart from cheapaml_pickups
CALL CHEAPAML_READ_PICKUP( nIter0, myThid )
C End start-from-iter-zero if/else block
ENDIF
C construct cheaplayer thickness
IF ( cheap_hFile .NE. ' ') THEN
iL = ILNBLNK(cheap_hFile)
WRITE(msgBuf,'(4A)') 'CHEAPAML_INIT_VARIA: ',
& 'BL thickness taken from ->', cheap_hFile(1:iL), '<-'
CALL PRINT_MESSAGE(msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
CALL READ_FLD_XY_RL( cheap_hFile,' ',cheapHgrid,0,myThid )
ELSE
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
cheapHgrid(i,j,bi,bj) = cheapaml_h
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
_EXCH_XY_RL( CheapHgrid, myThid )
c!BD IF ( cheap_prFile .NE. ' ') THEN
c!BD write(*,*)'Conv precip taken from ->',cheap_prFile
c!BD CALL READ_FLD_XY_RL( cheap_prFile,' ',cheapPrGrid,0,myThid )
c!BD ELSE
c!BD DO bj = myByLo(myThid), myByHi(myThid)
c!BD DO bi = myBxLo(myThid), myBxHi(myThid)
c!BD DO j=1-OLy,sNy+OLy
c!BD DO i=1-OLx,sNx+OLx
c!BD cheapPrGrid(i,j,bi,bj) = 0.0 _d 0
c!BD ENDDO
c!BD ENDDO
c!BD ENDDO
c!BD ENDDO
c!BD ENDIF
c!BD _EXCH_XY_RL( cheapPrGrid, myThid )
C fill in outer edges
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO j=1-OLy,sNy+OLy
jG = myYGlobalLo-1+(bj-1)*sNy+j
DO i=1-OLx,sNx+OLx
iG=myXGlobalLo-1+(bi-1)*sNx+i
IF ( .NOT.cheapamlXperiodic .AND. iG.LT.1 ) THEN
Tair(i,j,bi,bj)=Tair(1,j,bi,bj)
qair(i,j,bi,bj)=qair(1,j,bi,bj)
Cheaptracer(i,j,bi,bj)=Cheaptracer(1,j,bi,bj)
CheapHgrid(i,j,bi,bj)=CheapHgrid(1,j,bi,bj)
ELSEIF ( .NOT.cheapamlXperiodic .AND. iG.GT.Nx ) THEN
Tair(i,j,bi,bj)=Tair(sNx,j,bi,bj)
qair(i,j,bi,bj)=qair(sNx,j,bi,bj)
Cheaptracer(i,j,bi,bj)=Cheaptracer(sNx,j,bi,bj)
CheapHgrid(i,j,bi,bj)=CheapHgrid(sNx,j,bi,bj)
ELSEIF ( .NOT.cheapamlYperiodic .AND. jG.LT.1 ) THEN
Tair(i,j,bi,bj)=Tair(i,1,bi,bj)
qair(i,j,bi,bj)=qair(i,1,bi,bj)
Cheaptracer(i,j,bi,bj)=Cheaptracer(i,1,bi,bj)
CheapHgrid(i,j,bi,bj)=CheapHgrid(i,1,bi,bj)
ELSEIF ( .NOT.cheapamlYperiodic .AND. jG.GT.Ny ) THEN
Tair(i,j,bi,bj)=Tair(i,sNy,bi,bj)
qair(i,j,bi,bj)=qair(i,sNy,bi,bj)
Cheaptracer(i,j,bi,bj)=Cheaptracer(i,sNy,bi,bj)
CheapHgrid(i,j,bi,bj)=CheapHgrid(i,sNy,bi,bj)
ENDIF
ENDDO
ENDDO
ENDDO
ENDDO
IF ( debugLevel.GE.debLevB .AND. nIter0.EQ.0 ) THEN
CALL WRITE_FLD_XY_RL('CheapHgrid', ' ', CheapHgrid, 0, myThid )
ENDIF
RETURN
END