***S/R CLASS_CONST - Communication subroutinesubroutine class_const (nom,valeur,nv,mode) 16 * implicit none integer nv character *(*) nom, mode character modec*3,nomc*8,type*1,valc*8 integer valeur(nv) * *Author * B. Bilodeau (June 2004) * *Revisions * *Object * Communication subroutine between the physics * and class. 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 "consphy_class.cdk"
#include "class_com.cdk"
* * conversion de minuscules a majuscules call low2up(nom, nomc) call low2up(mode,modec) * if (nomc.eq.'CPD') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,cpd,1) endif * else if (nomc.eq.'DELTA') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,delta2,1) endif * else if (nomc.eq.'GRAV') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,grav,1) endif * else if (nomc.eq.'KARMAN') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,karman,1) endif * else if (nomc.eq.'RGASD') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,rgasd,1) endif * else if (nomc.eq.'RGASV') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,rgasv,1) endif * else if (nomc.eq.'STEFAN') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,stefan,1) endif * else if (nomc.eq.'TCDK') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,tcdk,1) endif * * else if (nomc.eq.'ANGMAX') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,angmax,1) endif * else if (nomc.eq.'AS') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,as,1) endif * else if (nomc.eq.'ASX') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,asx,1) endif * else if (nomc.eq.'BETA') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,beta,1) endif * else if (nomc.eq.'BS') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,bs,1) endif * else if (nomc.eq.'CI') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,ci,1) endif * else if (nomc.eq.'FACTN') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,factn,1) endif * else if (nomc.eq.'HMIN') THEN * if (modec.eq.'GET') THEN write(6,1000) nomc call qqexit(1) else if (modec.eq.'SET') THEN call movlev(valeur,hmin,1) endif * else write(6,1010) nomc call qqexit(1) endif * * 1000 FORMAT ( ' *****************************************', + / ' *****************************************', + / ' * *', + / ' ***** ABORT ***** ABORT ***** ABORT *****', + / ' * *', + / ' * CANNOT GET VALUE OF ',A8, ' *', + / ' * WITH A CALL TO CLASS_CONST *', + / ' * *', + / ' *****************************************', + / ' *****************************************') * 1010 FORMAT ( ' *****************************************', + / ' *****************************************', + / ' * *', + / ' ***** ABORT ***** ABORT ***** ABORT *****', + / ' * *', + / ' * ', A8, 'IS AN INVALID OPTION *', + / ' * OF SUBROUTINE CLASS_CONST *', + / ' * *', + / ' *****************************************', + / ' *****************************************') * * RETURN END