copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
*
subroutine set_sor 1,3
implicit none
*
#include "rec.cdk"
#include "grd.cdk"
#include "cdate.cdk"
#include "partopo.cdk"
#include "sor.cdk"
#include "vinterpo.cdk"
#include "path.cdk"
*
integer process_f_callback,longueur
external process_f_callback,longueur,
$ set_level,set_step,set_grid,set_var
character*256 Lun_sortie_S
integer ip1,fstdate,newdate,dat3,err,p1a,p1b,i,j,nis,njs
real*8 v1,v2,v3,zero,c1
data zero,c1 /0.0d0,2040.d0/
*
*------------------------------------------------------------------
*
p1a = 10
p1b = -10
Lun_sortie_S =
$ dfwmil(1:longueur(dfwmil))//'/process/output_settings'
*
levout_typ ='@'
stepout_typ='@'
gridout_typ='@'
varout_set = 0
varoutp_set= 0
*
if (myproc.eq.0) then
open (37,file=Lun_sortie_S,access='SEQUENTIAL',
$ iostat=err,status='OLD',form='UNFORMATTED')
if (err.eq.0) then
call rpn_fortran_callback ( 'levels' ,set_level,' ',p1a,p1b )
call rpn_fortran_callback ( 'steps' ,set_step ,' ',p1a,p1b )
call rpn_fortran_callback ( 'grids' ,set_grid ,' ',p1a,p1b )
call rpn_fortran_callback ( 'sortie' ,set_var ,' ',p1a,p1b )
call rpn_fortran_callback ( 'sortie_p',set_var ,' ',p1a,p1b )
err= process_f_callback(Lun_sortie_s(1:longueur(Lun_sortie_s)))
close(37)
endif
endif
*
call RPN_COMM_bcst_world ( sor_c_first, sor_c_last, 0 )
call RPN_COMM_bcst_world ( sor_i_first, sor_i_last, 0 )
call RPN_COMM_bcst_world ( sor_l_first, sor_l_last, 0 )
call RPN_COMM_bcst_world ( sor_r_first, sor_r_last, 0 )
*
call RPN_COMM_bcst_world ( comout_c_first , comout_c_last , 0 )
call RPN_COMM_bcst_world ( comout_i_first , comout_i_last , 0 )
call RPN_COMM_bcst_world ( comout_r_first , comout_r_last , 0 )
call RPN_COMM_bcst_world ( comout_r8_first, comout_r8_last, 0 )
*
if (Grd_proj_S.eq.'P') then
gtgrtyp = 'N'
call cxgaig (gtgrtyp,igs(1),igs(2),igs(3),igs(4),
$ 0.,0.,1000.,Grd_dgrw)
elseif (Grd_proj_S.eq.'M') then
gtgrtyp = 'E'
call cxgaig (gtgrtyp,igs(1),igs(2),igs(3),igs(4),
$ Grd_xlat1,Grd_xlon1,Grd_xlat2,Grd_xlon2)
elseif (Grd_proj_S.eq.'L') then
gtgrtyp = 'E'
call cxgaig (gtgrtyp,igs(1),igs(2),igs(3),igs(4),
$ Grd_xlat1,Grd_xlon1,Grd_xlat2,Grd_xlon2)
elseif (Grd_proj_S.ne.'X') then
print *,' Wrong grid projection. Grd_proj=[',Grd_proj_S,']'
call mc2stop
(-1)
endif
*
if (Grd_dx.lt.100.) then
ogrd_v1 = 20. * Grd_dx
else if (Grd_dx.lt.10000.) then
ogrd_v1 = .2 * Grd_dx
else
ogrd_v1 = 0.0004 * Grd_dx - 4.
endif
ogrd_v1 = min(c1,max(zero,ogrd_v1))
ogrd_v2 = (Grd_dgrw + Grd_phir) / 10.
*
call datp2f
(fstdate,gcrunstrt)
err = newdate(fstdate,out_dat2,dat3,-3)
out_h0 = dat3/1000000
*
call datp2f
(out_dat0,gcrunstrt)
*
gttpvar = 'P'
*
papositdh= 0
pahuvd = 0
pahttd = 0
pahwwd = 0
papositp = 0
pahwwp = 0
*------------------------------------------------------------------
return
end