pkg/ctrl/ctrl_set_fname.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
5d5c0b0d52 Patr*0002
f9d7cbfb72 Ou W*0003 CBOP
                0004 C     !ROUTINE: CTRL_SET_FNAME
                0005 C     !INTERFACE:
                0006       SUBROUTINE CTRL_SET_FNAME( xx_fname, fname, myThid )
5d5c0b0d52 Patr*0007
f9d7cbfb72 Ou W*0008 C     !DESCRIPTION:
                0009 C     ==================================================================
                0010 C     SUBROUTINE CTRL_SET_FNAME
                0011 C     ==================================================================
                0012 C     o get filename for control variable and adjoint thereof
                0013 C     started: heimbach@mit.edu, 16-Aug-2001
                0014 C     ==================================================================
5d5c0b0d52 Patr*0015
f9d7cbfb72 Ou W*0016 C     !USES:
                0017       IMPLICIT NONE
5d5c0b0d52 Patr*0018
f9d7cbfb72 Ou W*0019 C     == global variables ==
5d5c0b0d52 Patr*0020 #include "EEPARAMS.h"
                0021 #include "SIZE.h"
                0022 #include "PARAMS.h"
5cf4364659 Mart*0023 #include "CTRL_SIZE.h"
4d72283393 Mart*0024 #include "CTRL.h"
65754df434 Mart*0025 #include "OPTIMCYCLE.h"
5d5c0b0d52 Patr*0026
f9d7cbfb72 Ou W*0027 C     !INPUT/OUTPUT PARAMETERS
                0028       CHARACTER*(*) xx_fname
de57a2ec4b Mart*0029       CHARACTER*(MAX_LEN_FNAM) fname(3)
f9d7cbfb72 Ou W*0030       INTEGER myThid
                0031
                0032 C     !FUNCTIONS:
                0033       INTEGER  ILNBLNK
                0034       EXTERNAL ILNBLNK
                0035
                0036 C     !LOCAL VARIABLES:
de57a2ec4b Mart*0037       INTEGER il, ic, l
f9d7cbfb72 Ou W*0038 CEOP
                0039
                0040       il = ILNBLNK( xx_fname )
                0041
de57a2ec4b Mart*0042       IF ( il .GT. 0 .AND. (il+13) .LE. MAX_LEN_FNAM ) THEN
                0043         ic = 0
f9d7cbfb72 Ou W*0044         l = il
de57a2ec4b Mart*0045         DO WHILE ( ic .EQ. 0 .AND. l .GE. 1 )
                0046           IF ( xx_fname(l:l) .EQ. '/' ) ic = l
f9d7cbfb72 Ou W*0047           l = l -1
                0048         ENDDO
                0049
                0050         WRITE(fname(1),'(2A,I10.10)')
                0051      &        xx_fname(1:il), '.', optimcycle
                0052         WRITE(fname(2),'(4A,I10.10)')
de57a2ec4b Mart*0053      &        xx_fname(1:ic), yadprefix, xx_fname(ic+1:il), '.',
f9d7cbfb72 Ou W*0054      &        optimcycle
                0055         WRITE(fname(3),'(4A,I10.10)')
de57a2ec4b Mart*0056      &        xx_fname(1:ic), 'hn', xx_fname(ic+1:il), '.',
f9d7cbfb72 Ou W*0057      &        optimcycle
                0058
                0059       ELSE
                0060         STOP 'ABNORMAL END: S/R CTRL_SET_FNAME'
                0061       ENDIF
                0062
                0063       RETURN
                0064       END