copyright (C) 2001 MSC-RPN COMM %%%MC2%%% *subroutine out_dynb (trname,is,nis,js,jn,njs, 1,8 $ iw,ie,niw,jw,njw) implicit none * character*8 trname(*) integer is,nis,js,jn,njs,iw,ie,niw,jw,njw * #include "consdyn_8.cdk"
#include "dynmem.cdk"
#include "rec.cdk"
#include "topo.cdk"
#include "yomdyn.cdk"
#include "sor.cdk"
#include "partopo.cdk"
* integer i,j,k,ind_o(gnk+1),cnt real us(minx:maxx,miny:maxy,gnk),vs(minx:maxx,miny:maxy,gnk) * *------------------------------------------------------------------ * do k=1,gnk+1 ind_o(k) = k end do * do k=1,gnk do j=1,ldnj do i=1,ldni us(i,j,k) = uup(i,j,k) * sqrt(sby(i,j)) vs(i,j,k) = vvp(i,j,k) * sqrt(sbx(i,j)) end do end do end do * cnt = 0 do 10 i=1,nvardyn do k=1,ntr if (udolist(i).eq.trname(k)) then cnt = cnt + 1 goto 10 endif end do 10 continue * write (out_unfc) 'DYNAMICS',cnt + 7 call writecasb
( hh0,minx,maxx,miny,maxy,is,nis,js,jn,njs,iw,ie, $ niw,jw,njw, 2,'MX ',1.0,ind_o,out_unfc ) call writecasb
( us,minx,maxx,miny,maxy,is,nis,js,jn,njs,iw,ie, $ niw,jw,njw,gnk,'UU ',1.0,ind_o,out_unfc ) call writecasb
( vs,minx,maxx,miny,maxy,is,nis,js,jn,njs,iw,ie, $ niw,jw,njw,gnk,'VV ',1.0,ind_o,out_unfc ) call writecasb
( wwp,minx,maxx,miny,maxy,is,nis,js,jn,njs,iw,ie, $ niw,jw,njw,gnk,'WZ ',1.0,ind_o,out_unfc ) call writecasb
( bbp,minx,maxx,miny,maxy,is,nis,js,jn,njs,iw,ie, $ niw,jw,njw,gnk,'BUOY',1.0,ind_o,out_unfc ) call writecasb
( ppp,minx,maxx,miny,maxy,is,nis,js,jn,njs,iw,ie, $ niw,jw,njw,gnk+1,'PREG',1.0,ind_o,out_unfc ) call writecasb
( hup,minx,maxx,miny,maxy,is,nis,js,jn,njs,iw,ie, $ niw,jw,njw,gnk,'HU ',1.0,ind_o,out_unfc ) do 20 i=1,nvardyn do k=1,ntr if (udolist(i).eq.trname(k)) then call writecasb
( trp(minx,miny,1,k),minx,maxx,miny,maxy, $ is,nis,js,jn,njs,iw,ie,niw,jw,njw,gnk, $ trname(k),1.0,ind_o,out_unfc ) goto 20 endif end do 20 continue * close (out_unfc) out_unfc = 0 * *------------------------------------------------------------------ return end *