!-------------------------------------- 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 wlog - write output message in cmclog file
*
#include "model_macros_f.h"
*
subroutine wlog (F_code_S) 11
*
implicit none
*
character*4 F_code_S
*
*author
* Andre Methot - cmc - feb 1994
*
*revision
* v2_00 - Desgagne M. - initial MPI version (from wlog v1_03)
* v2_21 - Lee V. - removed Slab_dato, using Out1_dato
* v3_01 - Desgagne M. - only Ptopo_myproc.eq.0 will write
* v3_12 - Lee V. - force wlog to write in proper time units
* v3_20 - Lee V. - added RPN_COMM_BARRIER before wlog print
*
*object
* see above id
*
*arguments
*
* Name I/O Description
*----------------------------------------------------------------
* F_code_S I code identifying the type of messages
* 'IOUT' ==> output message (initialization)
* 'FOUT' ==> output message (forecast)
* 'IEND' ==> end message (initialization)
* 'FEND' ==> end message (forecast)
* 'BKUP' ==> backup for restart
* 'STOP' ==> stop message
* 'CSTR' ==> model start: message for analysis cycle
* 'CEND' ==> model end: message for analysis cycle
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
#include "lctl.cdk"
#include "out3.cdk"
#include "cstv.cdk"
#include "ptopo.cdk"
*
*modules
integer cmcwlog,longueur,newdate
external cmcwlog,longueur,newdate
*
character ptmesg_S*80, ptcy_S*8, ptwcy_S*10, ptzcy_S*10
character*20 string_S
character*10 unit_S,ptip2_S
character*6 format_S
character*4 dumc_S
integer err, ip2, m, cy, i,ndigits,dat1,dat2
**
* ---------------------------------------------------------------
*
err = newdate ( Out3_date, dat1, dat2, -3 )
*
call rpn_comm_Barrier("grid", err)
if (Ptopo_myproc.ne.0) return
*
do m=1,80
ptmesg_S(m:m) = ' '
end do
*
* Default, ip2 is in hours
ip2 = nint(real(Lctl_step)*Cstv_dt_8/3600.)
unit_S = 'hours'
* For just the prog in days
if (Out3_unit_S.eq.'D')then
ip2 = nint(dble(Lctl_step)*Cstv_dt_8/3600./24.)
unit_S = 'days'
endif
* For just the prog in minutes
if (Out3_unit_S.eq.'M')then
ip2 = nint((dble(Lctl_step)*Cstv_dt_8) / 60.)
unit_S = 'minutes'
endif
* For just the prog in seconds
if (Out3_unit_S.eq.'S')then
ip2 = nint(dble(Lctl_step)*Cstv_dt_8)
unit_S = 'seconds'
endif
* For just the prog in steps
if (Out3_unit_S.eq.'P')then
ip2 = Lctl_step
unit_S = 'timesteps'
endif
ndigits = Out3_ndigits
if (ndigits.eq.-1) ndigits=3
write(format_S,999)ndigits,ndigits
999 format('(I',I1,'.',I1,')')
write(ptip2_S,format_S) ip2
call up2low(Out3_unit_S,dumc_S)
string_s=ptip2_s(1:longueur(ptip2_s))//dumc_S//' '//unit_s(1:longueur(unit_s))
*
if ( F_code_S .eq. 'IOUT' ) then
ptmesg_S=' '//string_S(1:longueur(string_S))//' completed during initialization'
err = cmcwlog('OU',ip2,Out3_etik_S,ptmesg_S)
else if ( F_code_S .eq. 'FOUT' ) then
ptmesg_S = ' '//string_S(1:longueur(string_S))//' completed during forecast'
err = cmcwlog('OU',ip2,Out3_etik_S,ptmesg_S)
else if ( F_code_S .eq. 'IEND' ) then
ptmesg_S = ' END OF INITIALIZATION at '//string_S(1:longueur(string_s))
err = cmcwlog('EN',ip2,Out3_etik_S,ptmesg_S)
else if ( F_code_S .eq. 'FEND' ) then
ptmesg_S = ' END OF INTEGRATION at '//string_S(1:longueur(string_s))
err = cmcwlog('EN',ip2,Out3_etik_S,ptmesg_S)
else if ( F_code_S .eq. 'BKUP' ) then
ptmesg_S = ' BACKUP FOR RESTART at '//string_S(1:longueur(string_s))
err = cmcwlog('BU',ip2,Out3_etik_S,ptmesg_S)
else if ( F_code_S .eq. 'STOP' ) then
ptmesg_S = ' PREMATURED STOP: END OF INTEGRATION'
err = cmcwlog('AB',ip2,Out3_etik_S,ptmesg_S)
else if ( F_code_S .eq. 'CSTR' ) then
write(ptzcy_S,'(i8.8)') dat1
write(ptwcy_S,'(''01'')')
ptwcy_S(3:4)=ptzcy_S(1:2)
read(ptwcy_S,'(i4.4)') cy
write(ptwcy_S,'(i8.8)') dat2
ptcy_S(1:6)=ptzcy_S(3:8)
ptcy_S(7:8)=ptwcy_S(1:2)
ptmesg_S = ' MODEL START: MESSAGE FOR ANALYSIS CYCLE'
err = cmcwlog('MO',cy,ptcy_S,ptmesg_S)
else if ( F_code_S .eq. 'CEND' ) then
write(ptzcy_S,'(i8.8)') dat1
write(ptwcy_S,'(''02'')')
ptwcy_S(3:4)=ptzcy_S(1:2)
read(ptwcy_S,'(i4.4)') cy
write(ptwcy_S,'(i8.8)') dat2
ptcy_S(1:6)=ptzcy_S(3:8)
ptcy_S(7:8)=ptwcy_S(1:2)
ptmesg_S = ' MODEL END: MESSAGE FOR ANALYSIS CYCLE'
err = cmcwlog('MO',cy,ptcy_S,ptmesg_S)
else
ptmesg_S = ' wrong usage of subroutine wlog'
err = cmcwlog('BB',ip2,Out3_etik_S,ptmesg_S)
endif
*
* ---------------------------------------------------------------
*
return
end