!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***S/R PHYCOM - Communication subroutine
subroutine phycom (nom,valeur,nv,mode) 4
*
#include "impnone.cdk"
integer nv
character *(*) nom, mode
character modec*3,nomc*8,type*1,valc*8
integer valeur(nv)
*
*Author
* B. Bilodeau (January 2001)
*
*Revisions
*
* S. Valcke (June 2005) - Added CPL_FLD
*Object
* Communication subroutine between the dynamics
* and the physics. REAL, INTEGER and LOGICAL
* constants can be exchanged.
*
*Arguments
*
* - Input -
* NOM name of the option to be treated
*
* - Input/Output -
* VALEUR value of the constant
*
* - Input -
* NV number of values to be treated
* MODE mode of operation : SET = initialize the value
* GET = extract the value
*
*Notes
*
* WCAP - default fraction of surface water capacity
* LEADFRAC - climatological value of leads in marine ice (fraction)
* DZMIN - minimum thickness all layers in the domain
* (used to determine sedimentation time step
* in microphysics schemes)
* NKSURF - index of the lowest level seen by the microphysics
* scheme for sedimentation calculations (the layers
* below are combined in one layer in order to increase
* sedimentation timestep)
*
*Implicites
*
**
*
#include "hscap.cdk"
REAL WCAP
#include "leads.cdk"
#include "dzcond.cdk"
#include "mountains.cdk"
*
integer il_i, il_j, il_ind
************************************************************************
*
* INITIALISATION DES CLEFS
*
* conversion de minuscules a majuscules
call low2up(nom, nomc)
call low2up(mode,modec)
*
if (nomc.eq.'WCAP') THEN
*
wcap = w1
*
if (modec.eq.'GET') THEN
call movlev(wcap,valeur,1)
else if (modec.eq.'SET') THEN
write(6,1000) nomc
call qqexit(1)
endif
*
else if (nomc.eq.'LEADFRAC') THEN
*
if (modec.eq.'GET') THEN
call movlev(leadfrac,valeur,1)
else if (modec.eq.'SET') THEN
write(6,1000) nomc
call qqexit(1)
endif
*
else if (nomc.eq.'DZMIN') THEN
*
if (modec.eq.'SET') THEN
call movlev(valeur,dzmin,1)
else if (modec.eq.'GET') THEN
call movlev(dzmin,valeur,1)
endif
*
else if (nomc.eq.'NKSURF') THEN
*
if (modec.eq.'SET') THEN
call movlev(valeur,nksurf,1)
else if (modec.eq.'GET') THEN
call movlev(nksurf,valeur,1)
endif
*
else if (nomc.eq.'VARMTN') THEN
*
if (modec.eq.'SET') THEN
call movlev(valeur,varmtn,1)
else if (modec.eq.'GET') THEN
call movlev(varmtn,valeur,1)
endif
*
else
write(6,1010) nomc
call qqexit(1)
endif
*
*
1000 FORMAT ( ' *****************************************',
+ / ' *****************************************',
+ / ' * *',
+ / ' ***** ABORT ***** ABORT ***** ABORT *****',
+ / ' * *',
+ / ' * CANNOT SET VALUE OF ',A8, ' *',
+ / ' * WITH A CALL TO PHYCOM *',
+ / ' * *',
+ / ' *****************************************',
+ / ' *****************************************')
*
1010 FORMAT ( ' *****************************************',
+ / ' *****************************************',
+ / ' * *',
+ / ' ***** ABORT ***** ABORT ***** ABORT *****',
+ / ' * *',
+ / ' * ', A8, 'IS AN INVALID OPTION *',
+ / ' * OF SUBROUTINE PHYCOM *',
+ / ' * *',
+ / ' *****************************************',
+ / ' *****************************************')
*
*
RETURN
END