!-------------------------------------- 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 shuffle - shuffle the VMM manager keys when renaming a variable
*
#include "model_macros_f.h"
*
subroutine shuffle (F_key,F_oldkey,F_name_S) 192,1
*
#include "impnone.cdk"
*
integer F_key,F_oldkey
character*8 F_name_S
*
*author
* Michel Roch - rpn - nov 1993
*
*revision
* v2_00 - Desgagne M. - initial MPI version (from shuffle v1_03)
*
*object
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_key I/O new key: void in input; old key in output
* F_oldkey I/O old key: key to be shuffled in input;
* void in output
* F_name_S I/O new name the data associated with the old
* key will be attributed to
*----------------------------------------------------------------
*
*implicits
#include "lun.cdk"
#include "setsor.cdk"
*
*modules
integer vmmrnm
external vmmrnm
**
integer i,pnerr
*
* ---------------------------------------------------------------
*
if(F_key .eq. -100) then
pnerr = vmmrnm(F_oldkey, F_name_S)
F_key = F_oldkey
F_oldkey = -100
*
* get variable index in global table and reset key value for output
*
do i = 1, Setsor_num
if (Setsor_name_s(i).eq.F_name_S) goto 20
end do
20 Setsor_key(i) = F_key
else
if (Lun_out.gt.0) write(Lun_out, 1000) F_name_S
call gefstop('shuffle')
endif
*
1000 format(
+//,'THE NEW KEY MUST BE VOID (-100) WHEN A RENAMING IS DONE',
+ /,'THE NEW NAME WAS ',a8,
+ /,'********* THE MODEL STOPS IN S/R SHUFFLE ***********',
+//)
*
* ---------------------------------------------------------------
*
return
end