copyright (C) 2001 MSC-RPN COMM %%%MC2%%% *subroutine out_dyn_n (trname,rstrt),6 implicit none * character*8 trname(*) logical rstrt * #include "dynmem.cdk"
#include "partopo.cdk"
#include "rec.cdk"
#include "grd.cdk"
#include "sor.cdk"
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
#include "topo.cdk"
* logical out_step,doneonce external out_step integer i,j,k,kk,step_id,level_id,grid_id,nk_o,nis,njs integer, dimension (:), allocatable :: ind_o data doneonce /.false./ save doneonce * *------------------------------------------------------------------ * call rpn_comm_xch_halo (ppp,minx,maxx,miny,maxy,ldni,ldnj, $ ndynvar*gnk+1,hx,hy,period_x,period_y,ldni,0) * if (rstrt.and..not.doneonce) goto 998 * *########## REGULAR OUTPUT ####################################### * do 100 i=1,nkout * if (varout_nvar(i).gt.0) then level_id= varout_p(1,i) grid_id= varout_p(2,i) step_id= varout_p(3,i) nvardyn = 0 if ( (stepout_typ( step_id).ne.'@') .and. $ (levout_typ (level_id).ne.'@') .and. $ (gridout_typ( grid_id).ne.'@') ) then * if (out_step
(gnstepno,stepout(1,step_id), $ stepout_typ(step_id),stepout_ns(step_id))) then if (myproc.eq.0) then write (6,900) i,level_id,grid_id,step_id print*, (varout_S(j,i) ,j=1,varout_nvar(i)) endif * *** Variables udolist = "#$%^&" do k=1,varout_nvar(i) udolist(k) = varout_S(k,i) end do nvardyn = varout_nvar(i) * *** Levels nk_o = levout_nlvl(level_id) allocate (ind_o(nk_o+1)) call out_slev
(level_id,nk_o,ind_o,'d') * *** Grid g_id = gridout(1,grid_id) g_if = gridout(2,grid_id) g_jd = gridout(3,grid_id) g_jf = gridout(4,grid_id) g_reduc = gridout(5,grid_id) call out_sgrid
* * producing the output call out_dynr
(trname,ind_o,nk_o,nstepsor_d) deallocate (ind_o) endif * endif endif * 100 continue * * *################################################################# * *########## SPECIAL OUTPUT FOR CASCADE ########################### * if ( (Grdc_proj_S.ne.'@').and.(Grdc_ndt.ge.0) ) then * out_ontimec = .false. if ( Grdc_ndt.eq.0 ) then if (gnstepno.eq.0) out_ontimec = .true. else out_ontimec = (mod(gnstepno,Grdc_ndt).eq.0) endif * if ( out_ontimec ) then * *** Variables nvardyn = 0 if (Grdc_trnm_S(1).eq.'@#$%') then do k=1,ntr nvardyn = nvardyn + 1 udolist(nvardyn) = trname(k) end do else do kk=1,max_trnm if (Grdc_trnm_S(kk).eq.'@#$%') goto 87 do k=1,ntr if (Grdc_trnm_S(kk).eq.trname(k)) then nvardyn = nvardyn + 1 udolist(nvardyn) = trname(k) endif end do end do endif * *** Grid 87 g_id = Grdc_gid g_if = Grdc_gif g_jd = Grdc_gjd g_jf = Grdc_gjf g_reduc = 1 call out_sgrid
* * producing the output call out_dync
(trname) * endif * out_ontimec = .false. endif * 998 doneonce = .true. * *################################################################# 900 format (/' ### ===> DYN OUTPUT SET #',i4,', Levels=',i4, $ ', Grid=',i4,', Step=',i4) *------------------------------------------------------------------ return end