!-------------------------------------- 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 listvmm - #include "model_macros_f.h"*
subroutine listvmm (vmmname,key,size,n,attribut),2 implicit none * character* (*) vmmname,attribut integer key,size,n *author * Michel Desgagne -- Fall 2006 * *revision * v3_30 - Desgagne - Initial version * *object * See above id. * *arguments * none * *implicits #include "glb_ld.cdk"
#include "vmmlist.cdk"
#include "ptopo.cdk"
* *modules character*9 mustexist logical gotit integer i,minx,maxx,miny,maxy,mink,maxk * * --------------------------------------------------------------- * mustexist= 'MUSTEXIST' gotit = .false. do i=1,len(attribut) if (attribut(i:i+len(mustexist)).eq.mustexist) gotit=.true. end do * if (gotit) then * if (.not.vmm_read_done_L) then * if (size.eq.LARRAY3D) then minx = l_minx maxx = l_maxx miny = l_miny maxy = l_maxy mink = 1 maxk = G_nk elseif (size.eq.LARRAY2D) then minx = l_minx maxx = l_maxx miny = l_miny maxy = l_maxy mink = 1 maxk = 1 elseif (size.eq.l_ni*l_nj*l_nk) then minx = 1 maxx = l_ni miny = 1 maxy = l_nj mink = 1 maxk = G_nk else if (Ptopo_myproc.eq.0) write (6,1001) size,vmmname call gem_stop
('LISTVMM - ABORT -',-1) endif * do i=1,n vmm2rstrt = vmm2rstrt + 1 vmm_token_2rstrt(vmm2rstrt,1) = key if (n.gt.1) vmm_token_2rstrt(vmm2rstrt,1) = key + i vmm_name_2rstrt(vmm2rstrt ) = vmmname vmm_token_2rstrt(vmm2rstrt,2) = minx vmm_token_2rstrt(vmm2rstrt,3) = maxx vmm_token_2rstrt(vmm2rstrt,4) = miny vmm_token_2rstrt(vmm2rstrt,5) = maxy vmm_token_2rstrt(vmm2rstrt,6) = mink vmm_token_2rstrt(vmm2rstrt,7) = maxk end do * else if (Ptopo_myproc.eq.0) write (6,1002) call gem_stop
('LISTVMM - ABORT -',-1) endif * endif * 1001 format (/' UNRECOGNIZABLE SHAPE(SIZE) FOR VMM VARIABLE TO RESTART: ',I8,X,a/) 1002 format (/' VMM_CREATE CANNOT BE CALLED AFTER "GLB_RESTART (R)" '/) * --------------------------------------------------------------- * return end