- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r6140 r9019 14 14 !! fin_date : Compute the final date YYYYMMDD.HHMMSS 15 15 !!---------------------------------------------------------------------- 16 !! * Modules used17 16 USE wrk_nemo ! Memory Allocation 18 17 USE par_kind ! Precision variables … … 36 35 37 36 IMPLICIT NONE 38 39 !! * Routine accessibility40 37 PRIVATE 41 PUBLIC dia_obs_init, & ! Initialize and read observations 42 & dia_obs, & ! Compute model equivalent to observations 43 & dia_obs_wri, & ! Write model equivalent to observations 44 & dia_obs_dealloc, & ! Deallocate dia_obs data 45 & calc_date ! Compute the date of a timestep 38 39 PUBLIC dia_obs_init ! Initialize and read observations 40 PUBLIC dia_obs ! Compute model equivalent to observations 41 PUBLIC dia_obs_wri ! Write model equivalent to observations 42 PUBLIC dia_obs_dealloc ! Deallocate dia_obs data 43 PUBLIC calc_date ! Compute the date of a timestep 46 44 47 45 !! * Module variables … … 51 49 INTEGER :: nn_1dint !: Vertical interpolation method 52 50 INTEGER :: nn_2dint !: Horizontal interpolation method 53 INTEGER, DIMENSION(imaxavtypes) :: & 54 & nn_profdavtypes !: Profile data types representing a daily average 51 INTEGER, DIMENSION(imaxavtypes) :: nn_profdavtypes !: Profile data types representing a daily average 55 52 INTEGER :: nproftypes !: Number of profile obs types 56 53 INTEGER :: nsurftypes !: Number of surface obs types 57 INTEGER, DIMENSION(:), ALLOCATABLE :: & 58 & nvarsprof, & !: Number of profile variables 59 & nvarssurf !: Number of surface variables 60 INTEGER, DIMENSION(:), ALLOCATABLE :: & 61 & nextrprof, & !: Number of profile extra variables 62 & nextrsurf !: Number of surface extra variables 63 INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sstbias_type !SST bias type 64 TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: & 65 & surfdata, & !: Initial surface data 66 & surfdataqc !: Surface data after quality control 67 TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: & 68 & profdata, & !: Initial profile data 69 & profdataqc !: Profile data after quality control 70 71 CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 72 & cobstypesprof, & !: Profile obs types 73 & cobstypessurf !: Surface obs types 54 INTEGER, DIMENSION(:), ALLOCATABLE :: nvarsprof, nvarssurf !: Number of profile & surface variables 55 INTEGER, DIMENSION(:), ALLOCATABLE :: nextrprof, nextrsurf !: Number of profile & surface extra variables 56 INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sstbias_type !: SST bias type 57 TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: surfdata, surfdataqc !: Initial surface data before & after quality control 58 TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdata, profdataqc !: Initial profile data before & after quality control 59 60 CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: cobstypesprof, cobstypessurf !: Profile & surface obs types 74 61 75 62 !!---------------------------------------------------------------------- … … 78 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 79 66 !!---------------------------------------------------------------------- 80 81 67 CONTAINS 82 68 … … 99 85 !! ! 15-02 (M. Martin) Simplification of namelist and code 100 86 !!---------------------------------------------------------------------- 101 102 IMPLICIT NONE 103 104 !! * Local declarations 105 INTEGER, PARAMETER :: & 106 & jpmaxnfiles = 1000 ! Maximum number of files for each obs type 107 INTEGER, DIMENSION(:), ALLOCATABLE :: & 108 & ifilesprof, & ! Number of profile files 109 & ifilessurf ! Number of surface files 87 INTEGER, PARAMETER :: jpmaxnfiles = 1000 ! Maximum number of files for each obs type 88 INTEGER, DIMENSION(:), ALLOCATABLE :: ifilesprof, ifilessurf ! Number of profile & surface files 110 89 INTEGER :: ios ! Local integer output status for namelist read 111 90 INTEGER :: jtype ! Counter for obs types … … 134 113 LOGICAL :: ln_nea ! Logical switch to remove obs near land 135 114 LOGICAL :: ln_altbias ! Logical switch for altimeter bias 136 LOGICAL :: ln_sstbias !:Logical switch for bias corection of SST115 LOGICAL :: ln_sstbias ! Logical switch for bias corection of SST 137 116 LOGICAL :: ln_ignmis ! Logical switch for ignoring missing files 138 117 LOGICAL :: ln_s_at_t ! Logical switch to compute model S at T obs … … 291 270 END DO 292 271 ENDIF 293 #if defined key_lim 2 || defined key_lim3272 #if defined key_lim3 294 273 IF (ln_sic) THEN 295 274 jtype = jtype + 1 … … 501 480 END SUBROUTINE dia_obs_init 502 481 482 503 483 SUBROUTINE dia_obs( kstp ) 504 484 !!---------------------------------------------------------------------- … … 525 505 !! ! 15-08 (M. Martin) Combined surface/profile routines. 526 506 !!---------------------------------------------------------------------- 527 !! * Modules used 528 USE dom_oce, ONLY : & ! Ocean space and time domain variables 529 & gdept_n, & 530 & gdept_1d 531 USE phycst, ONLY : & ! Physical constants 532 & rday 533 USE oce, ONLY : & ! Ocean dynamics and tracers variables 534 & tsn, & 535 & un, vn, & 536 & sshn 537 USE phycst, ONLY : & ! Physical constants 538 & rday 507 USE dom_oce, ONLY : gdept_n, gdept_1d ! Ocean space and time domain variables 508 USE phycst , ONLY : rday ! Physical constants 509 USE oce , ONLY : tsn, un, vn, sshn ! Ocean dynamics and tracers variables 510 USE phycst , ONLY : rday ! Physical constants 539 511 #if defined key_lim3 540 USE ice, ONLY : & ! LIM3 Ice model variables 541 & frld 542 #endif 543 #if defined key_lim2 544 USE ice_2, ONLY : & ! LIM2 Ice model variables 545 & frld 512 USE ice , ONLY : at_i ! LIM3 Ice model variables 546 513 #endif 547 514 IMPLICIT NONE … … 567 534 & zgphi1, & ! Model latitudes for prof variable 1 568 535 & zgphi2 ! Model latitudes for prof variable 2 569 #if ! defined key_lim 2 && ! defined key_lim3570 REAL(wp), POINTER, DIMENSION(:,:) :: frld536 #if ! defined key_lim3 537 REAL(wp), POINTER, DIMENSION(:,:) :: at_i 571 538 #endif 572 539 LOGICAL :: llnightav ! Logical for calculating night-time average … … 582 549 CALL wrk_alloc( jpi, jpj, zgphi1 ) 583 550 CALL wrk_alloc( jpi, jpj, zgphi2 ) 584 #if ! defined key_lim 2 && ! defined key_lim3585 CALL wrk_alloc(jpi,jpj, frld)551 #if ! defined key_lim3 552 CALL wrk_alloc(jpi,jpj,at_i) 586 553 #endif 554 !----------------------------------------------------------------------- 587 555 588 556 IF(lwp) THEN … … 595 563 596 564 !----------------------------------------------------------------------- 597 ! No LIM => frld== 0.0_wp598 !----------------------------------------------------------------------- 599 #if ! defined key_lim 2 && ! defined key_lim3600 frld(:,:) = 0.0_wp565 ! No LIM => at_i == 0.0_wp 566 !----------------------------------------------------------------------- 567 #if ! defined key_lim3 568 at_i(:,:) = 0.0_wp 601 569 #endif 602 570 !----------------------------------------------------------------------- … … 665 633 zsurfvar(:,:) = sshn(:,:) 666 634 llnightav = .FALSE. 667 #if defined key_lim 2 || defined key_lim3635 #if defined key_lim3 668 636 CASE('sic') 669 637 IF ( kstp == 0 ) THEN … … 678 646 CYCLE 679 647 ELSE 680 zsurfvar(:,:) = 1._wp - frld(:,:)648 zsurfvar(:,:) = at_i(:,:) 681 649 ENDIF 682 650 … … 702 670 CALL wrk_dealloc( jpi, jpj, zgphi1 ) 703 671 CALL wrk_dealloc( jpi, jpj, zgphi2 ) 704 #if ! defined key_lim 2 && ! defined key_lim3705 CALL wrk_dealloc(jpi,jpj, frld)672 #if ! defined key_lim3 673 CALL wrk_dealloc(jpi,jpj,at_i) 706 674 #endif 707 675
Note: See TracChangeset
for help on using the changeset viewer.
