!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%% ***S/R PHYCOM - Communication subroutinesubroutine phycom (nom,valeur,nv,mode) 2 * #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 * *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"
* * 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