Ignore:
Timestamp:
Mar 21, 2014 11:00:16 AM (10 years ago)
Author:
raasch
Message:

Changed:


-s real64 removed (.mrun.config.hlrnIII)
-r8 removed (.mrun.config.imuk)
deleted: .mrun.config.imuk_ice2_netcdf4 .mrun.config.imuk_hlrn

REAL constants defined as wp-kind in modules

"baroclinicity" renamed "baroclinity", "ocean version" replaced by
"ocean mode"

code parts concerning old output formats "iso2d" and "avs" removed.
netCDF is the only remaining output format.

Errors:


bugfix: duplicate error message 56 removed

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/check_open.f90

    r1321 r1327  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! parts concerning iso2d and avs output removed
    2323!
    2424! Former revisions:
     
    7676
    7777    USE control_parameters,                                                    &
    78         ONLY:  avs_data_file, avs_output, coupling_char,                       &
    79                data_output_2d_on_each_pe, do3d_compress, host, iso2d_output,   &
     78        ONLY:  avs_data_file, coupling_char, data_output_2d_on_each_pe, host,  &
    8079               message_string, mid, netcdf_data_format, nz_do3d, openfile,     &
    8180               return_addres, return_username, run_description_header, runnr
     
    231230          ENDIF
    232231
    233        CASE ( 27, 28, 29, 31, 32, 33, 71:73, 90:99 )
     232       CASE ( 27, 28, 29, 31, 33, 71:73, 90:99 )
    234233
    235234!
     
    372371             DEALLOCATE( eta, ho, hu )
    373372
    374 !
    375 !--          Create output file for local parameters
    376              IF ( iso2d_output )  THEN
    377                 OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char,              &
    378                            FORM='FORMATTED', DELIM='APOSTROPHE' )
    379                 openfile(27)%opened = .TRUE.
    380              ENDIF
    381 
    382373          ENDIF
    383374
     
    400391             ENDIF
    401392!
    402 !--          Determine and write ISO2D coordiante header
     393!--          Determine and write ISO2D coordinate header
    403394             ALLOCATE( eta(0:nz+1), ho(0:nx+1), hu(0:nx+1) )
    404395             hu = 0.0
     
    412403             WRITE (22)  dx,eta,hu,ho
    413404             DEALLOCATE( eta, ho, hu )
    414 !
    415 !--          Create output file for local parameters
    416              OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char,                 &
    417                         FORM='FORMATTED', DELIM='APOSTROPHE' )
    418              openfile(28)%opened = .TRUE.
    419405
    420406          ENDIF
     
    450436             WRITE (23)  dx,eta,hu,ho
    451437             DEALLOCATE( eta, ho, hu )
    452 !
    453 !--          Create output file for local parameters
    454              OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char,                 &
    455                         FORM='FORMATTED', DELIM='APOSTROPHE' )
    456              openfile(29)%opened = .TRUE.
    457438
    458439          ENDIF
     
    468449!
    469450!--          Specifications for combine_plot_fields
    470              IF ( .NOT. do3d_compress )  THEN
    471                 WRITE ( 30 )  -nbgp,nx+nbgp,-nbgp,ny+nbgp, 0 ,nz_do3d
    472                 WRITE ( 30 )  0,nx+1,0,ny+1,0,nz_do3d
    473              ENDIF
     451             WRITE ( 30 )  -nbgp,nx+nbgp,-nbgp,ny+nbgp, 0 ,nz_do3d
     452             WRITE ( 30 )  0,nx+1,0,ny+1,0,nz_do3d
    474453#endif
    475 !
    476 !--          Write coordinate file for AVS:
    477 !--          First determine file names (including cyle numbers) of AVS files on
    478 !--          target machine (to which the files are to be transferred).
    479 !--          Therefore path information has to be obtained first.
    480              IF ( avs_output )  THEN
    481                 iaddres = LEN_TRIM( return_addres )
    482                 iusern  = LEN_TRIM( return_username )
    483 
    484                 OPEN ( 3, FILE='OUTPUT_FILE_CONNECTIONS', FORM='FORMATTED' )
    485                 DO  WHILE ( .NOT. avs_coor_file_found  .OR.                    &
    486                             .NOT. avs_data_file_found )
    487 
    488                    READ ( 3, '(A)', END=1 )  line
    489 
    490                    SELECT CASE ( line(1:11) )
    491 
    492                       CASE ( 'PLOT3D_COOR' )
    493                          READ ( 3, '(A/A)' )  avs_coor_file_catalog,           &
    494                                               avs_coor_file_localname
    495                          avs_coor_file_found = .TRUE.
    496 
    497                       CASE ( 'PLOT3D_DATA' )
    498                          READ ( 3, '(A/A)' )  avs_data_file_catalog,           &
    499                                               avs_data_file_localname
    500                          avs_data_file_found = .TRUE.
    501 
    502                       CASE DEFAULT
    503                          READ ( 3, '(A/A)' )  line, line
    504 
    505                    END SELECT
    506 
    507                 ENDDO
    508 !
    509 !--             Now the cycle numbers on the remote machine must be obtained
    510 !--             using batch_scp
    511        1        CLOSE ( 3 )
    512                 IF ( .NOT. avs_coor_file_found  .OR.                           &
    513                      .NOT. avs_data_file_found )  THEN
    514                    message_string= 'no filename for AVS-data-file ' //         &
    515                                    'found in MRUN-config-file' //              &
    516                                    ' &filename in FLD-file set to "unknown"'
    517                    CALL message( 'check_open', 'PA0169', 0, 1, 0, 6, 0 )
    518 
    519                    avs_coor_file = 'unknown'
    520                    avs_data_file = 'unknown'
    521                 ELSE
    522                    get_filenames = .TRUE.
    523                    IF ( TRIM( host ) == 'hpmuk'  .OR.                          &
    524                         TRIM( host ) == 'lcmuk' )  THEN
    525                       batch_scp = '/home/raasch/pub/batch_scp'
    526                    ELSEIF ( TRIM( host ) == 'nech' )  THEN
    527                       batch_scp = '/ipf/b/b323011/pub/batch_scp'
    528                    ELSEIF ( TRIM( host ) == 'ibmh'  .OR.                       &
    529                             TRIM( host ) == 'ibmb' )  THEN
    530                       batch_scp = '/home/h/niksiraa/pub/batch_scp'
    531                    ELSEIF ( TRIM( host ) == 't3eb' )  THEN
    532                       batch_scp = '/home/nhbksira/pub/batch_scp'
    533                    ELSE
    534                       message_string= 'no path for batch_scp on host "' //     &
    535                                        TRIM( host ) // '"'
    536                       CALL message( 'check_open', 'PA0170', 0, 1, 0, 6, 0 )
    537                       get_filenames = .FALSE.
    538                    ENDIF
    539 
    540                    IF ( get_filenames )  THEN
    541 !
    542 !--                   Determine the coordinate file name.
    543 !--                   /etc/passwd serves as Dummy-Datei, because it is not
    544 !--                   really transferred.
    545                       command = TRIM( batch_scp ) // ' -n -u ' //              &
    546                          return_username(1:iusern) // ' ' //                   &
    547                          return_addres(1:iaddres) // ' /etc/passwd "' //       &
    548                          TRIM( avs_coor_file_catalog ) // '" ' //              &
    549                          TRIM( avs_coor_file_localname ) // ' > REMOTE_FILENAME'
    550 
    551                       CALL local_system( command )
    552                       OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' )
    553                       READ ( 3, '(A)' )  avs_coor_file
    554                       CLOSE ( 3 )
    555 !
    556 !--                   Determine the data file name
    557                       command = TRIM( batch_scp ) // ' -n -u ' //              &
    558                          return_username(1:iusern) // ' ' //                   &
    559                          return_addres(1:iaddres) // ' /etc/passwd "' //       &
    560                          TRIM( avs_data_file_catalog ) // '" ' //              &
    561                          TRIM( avs_data_file_localname ) // ' > REMOTE_FILENAME'
    562 
    563                       CALL local_system( command )
    564                       OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' )
    565                       READ ( 3, '(A)' )  avs_data_file
    566                       CLOSE ( 3 )
    567 
    568                    ELSE
    569 
    570                       avs_coor_file = 'unknown'
    571                       avs_data_file = 'unknown'
    572 
    573                    ENDIF
    574 
    575                 ENDIF
    576 
    577 !
    578 !--             Output of the coordinate file description for FLD-file
    579                 OPEN ( 33, FILE='PLOT3D_FLD_COOR', FORM='FORMATTED' )
    580                 openfile(33)%opened = .TRUE.
    581                 WRITE ( 33, 3300 )  TRIM( avs_coor_file ),                     &
    582                                     TRIM( avs_coor_file ), (nx+2*nbgp)*4,      &
    583                                     TRIM( avs_coor_file ), (nx+2*nbgp)*4+(ny+2*nbgp)*4
    584            
    585 
    586                 ALLOCATE( xkoor(0:nx+1), ykoor(0:ny+1), zkoor(0:nz_do3d) )
    587                 DO  i = 0, nx+1
    588                    xkoor(i) = i * dx
    589                 ENDDO
    590                 DO  j = 0, ny+1
    591                    ykoor(j) = j * dy
    592                 ENDDO
    593                 DO  k = 0, nz_do3d
    594                    zkoor(k) = zu(k)
    595                 ENDDO
    596 
    597 !
    598 !--             Create and write on AVS coordinate file
    599                 OPEN ( 31, FILE='PLOT3D_COOR', FORM='UNFORMATTED' )
    600                 openfile(31)%opened = .TRUE.
    601 
    602                 WRITE (31)  xkoor, ykoor, zkoor
    603                 DEALLOCATE( xkoor, ykoor, zkoor )
    604 
    605 !
    606 !--             Create FLD file (being written on in close_file)
    607                 OPEN ( 32, FILE='PLOT3D_FLD', FORM='FORMATTED' )
    608                 openfile(32)%opened = .TRUE.
    609 
    610 !
    611 !--             Create flag file for compressed 3D output,
    612 !--             influences output commands in mrun
    613                 IF ( do3d_compress )  THEN
    614                    OPEN ( 3, FILE='PLOT3D_COMPRESSED', FORM='FORMATTED' )
    615                    WRITE ( 3, '(1X)' )
    616                    CLOSE ( 3 )
    617                 ENDIF
    618 
    619              ENDIF
    620 
    621           ENDIF
    622 
    623 !
    624 !--       In case of data compression output of the coordinates of the
    625 !--       corresponding partial array of a PE only once at the top of the file
    626           IF ( avs_output  .AND.  do3d_compress )  THEN
    627              WRITE ( 30 )  nxlg, nxrg, nysg, nyng, nzb, nz_do3d
    628454          ENDIF
    629455
Note: See TracChangeset for help on using the changeset viewer.