2508
2509
2510
2511
2512 integer, intent(in) :: ng, tile, model
2513 integer, intent(in) :: LBi, UBi, LBj, UBj
2514
2515
2516
2517# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
2518 defined opt_observations || defined sensitivity_4dvar || \
2519 defined so_semi
2520# ifndef OBS_SPACE
2521 logical :: GotScope(6)
2522
2523# endif
2524# endif
2525 integer :: cr, i, status, vindex
2526 integer :: Vsize(4)
2527# ifdef CHECKSUM
2528 integer(i8b) :: Fhash
2529# endif
2530
2531 real(dp), parameter :: Fscl = 1.0_dp
2532
2533 real(r8) :: Fmax, Fmin
2534
2535 character (len=256) :: ncname
2536
2537 character (len=*), parameter :: MyFile = &
2538 & __FILE__//", get_grid_pio"
2539
2540 TYPE (IO_desc_t), pointer :: ioDesc
2541 TYPE (My_VarDesc) :: pioVar
2542# if defined UV_DRAG_GRID && !defined ANA_DRAG
2543 TYPE (My_VarDesc) :: pioVar_dragL, pioVar_dragQ, pioVar_ZoBL
2544# endif
2545
2546
2547 sourcefile=myfile
2548
2549
2550
2551
2552
2553
2554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2555 ncname=grd(ng)%name
2556
2557
2558
2559 IF (grd(ng)%pioFile%fh.eq.-1) THEN
2560 CALL pio_netcdf_open (ng, model, ncname, 0, grd(ng)%pioFile)
2561 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
2562 WRITE (stdout,10) trim(ncname)
2563 RETURN
2564 END IF
2565 END IF
2566
2567
2568
2569 CALL pio_netcdf_check_dim (ng, model, ncname, &
2570 & piofile = grd(ng)%pioFile)
2571 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2572
2573
2574
2575 CALL pio_netcdf_inq_var (ng, model, ncname, &
2576 & piofile = grd(ng)%pioFile)
2577 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2578
2579# ifdef NESTING
2580
2581
2582
2583
2584 DO i=1,ncontact
2585 IF (rcontact(i)%receiver_grid.eq.ng) THEN
2586 cr=i
2587 EXIT
2588 END IF
2589 END DO
2590# endif
2591
2592
2593
2594
2595
2596 IF (.not.find_string(var_name,n_var,'xl',vindex)) THEN
2597 IF (master) WRITE (stdout,20) 'xl', trim(ncname)
2598 exit_flag=2
2599 RETURN
2600 END IF
2601 IF (.not.find_string(var_name,n_var,'el',vindex)) THEN
2602 IF (master) WRITE (stdout,20) 'el', trim(ncname)
2603 exit_flag=2
2604 RETURN
2605 END IF
2606 IF (.not.find_string(var_name,n_var,'spherical',vindex)) THEN
2607 IF (master) WRITE (stdout,20) 'spherical', trim(ncname)
2608 exit_flag=2
2609 RETURN
2610 END IF
2611 IF (.not.find_string(var_name,n_var,'h',vindex)) THEN
2612 IF (master) WRITE (stdout,20) 'h', trim(ncname)
2613 exit_flag=2
2614 RETURN
2615 END IF
2616# ifdef ICESHELF
2617 IF (.not.find_string(var_name,n_var,'zice',vindex)) THEN
2618 IF (master) WRITE (stdout,20) 'zice', trim(ncname)
2619 exit_flag=2
2620 RETURN
2621 END IF
2622# endif
2623 IF (.not.find_string(var_name,n_var,'f',vindex)) THEN
2624 IF (master) WRITE (stdout,20) 'f', trim(ncname)
2625 exit_flag=2
2626 RETURN
2627 END IF
2628 IF (.not.find_string(var_name,n_var,'pm',vindex)) THEN
2629 IF (master) WRITE (stdout,20) 'pm', trim(ncname)
2630 exit_flag=2
2631 RETURN
2632 END IF
2633 IF (.not.find_string(var_name,n_var,'pn',vindex)) THEN
2634 IF (master) WRITE (stdout,20) 'pn', trim(ncname)
2635 exit_flag=2
2636 RETURN
2637 END IF
2638# if (defined CURVGRID && defined UV_ADV)
2639 IF (.not.find_string(var_name,n_var,'dndx',vindex)) THEN
2640 IF (master) WRITE (stdout,20) 'dndx', trim(ncname)
2641
2642
2643 END IF
2644 IF (.not.find_string(var_name,n_var,'dmde',vindex)) THEN
2645 IF (master) WRITE (stdout,20) 'dmde', trim(ncname)
2646
2647
2648 END IF
2649# endif
2650# ifdef CURVGRID
2651 IF (.not.find_string(var_name,n_var,'angle',vindex)) THEN
2652 IF (master) WRITE (stdout,20) 'angle', trim(ncname)
2653 exit_flag=2
2654 RETURN
2655 END IF
2656# endif
2657# ifdef MASKING
2658 IF (.not.find_string(var_name,n_var,'mask_rho',vindex)) THEN
2659 IF (master) WRITE (stdout,20) 'mask_rho', trim(ncname)
2660 exit_flag=2
2661 RETURN
2662 END IF
2663 IF (.not.find_string(var_name,n_var,'mask_u',vindex)) THEN
2664 IF (master) WRITE (stdout,20) 'mask_u', trim(ncname)
2665 exit_flag=2
2666 RETURN
2667 END IF
2668 IF (.not.find_string(var_name,n_var,'mask_v',vindex)) THEN
2669 IF (master) WRITE (stdout,20) 'mask_v', trim(ncname)
2670 exit_flag=2
2671 RETURN
2672 END IF
2673 IF (.not.find_string(var_name,n_var,'mask_psi',vindex)) THEN
2674 IF (master) WRITE (stdout,20) 'mask_psi', trim(ncname)
2675 exit_flag=2
2676 RETURN
2677 END IF
2678# endif
2679# if defined WTYPE_GRID && \
2680 (defined
lmd_skpp || defined solar_source) && \
2681
2682 IF (.not.find_string(var_name,n_var,'wtype_grid',vindex)) THEN
2683 IF (master) WRITE (stdout,20) 'wtype_grid', trim(ncname)
2684 exit_flag=2
2685 RETURN
2686 END IF
2687# endif
2688# ifndef ANA_SPONGE
2689 IF (luvsponge(ng)) THEN
2690 IF (.not.find_string(var_name,n_var,'visc_factor',vindex)) THEN
2691 IF (master) WRITE (stdout,20) 'visc_factor', trim(ncname)
2692 exit_flag=2
2693 RETURN
2694 END IF
2695 END IF
2696# ifdef SOLVE3D
2697 IF (any(ltracersponge(:,ng))) THEN
2698 IF (.not.find_string(var_name,n_var,'diff_factor',vindex)) THEN
2699 IF (master) WRITE (stdout,20) 'diff_factor', trim(ncname)
2700 exit_flag=2
2701 RETURN
2702 END IF
2703 END IF
2704# endif
2705# endif
2706# if defined UV_DRAG_GRID && !defined ANA_DRAG
2707# ifdef UV_LOGDRAG
2708 IF (.not.find_string(var_name,n_var,trim(vname(1,idzobl)), &
2709 & vindex)) THEN
2710 IF (master) WRITE (stdout,20) trim(vname(1,idzobl)), &
2711 & trim(ncname)
2712 exit_flag=2
2713 RETURN
2714 ELSE
2715 piovar_zobl%vd=var_desc(vindex)
2716 piovar_zobl%gtype=r2dvar
2717 END IF
2718# endif
2719# ifdef UV_LDRAG
2720 IF (.not.find_string(var_name,n_var,trim(vname(1,idragl)), &
2721 & vindex)) THEN
2722 IF (master) WRITE (stdout,20) trim(vname(1,idragl)), &
2723 & trim(ncname)
2724 exit_flag=2
2725 RETURN
2726 ELSE
2727 piovar_dragl%vd=var_desc(vindex)
2728 piovar_dragl%gtype=r2dvar
2729 END IF
2730# endif
2731# ifdef UV_QDRAG
2732 IF (.not.find_string(var_name,n_var,trim(vname(1,idragq)), &
2733 & vindex)) THEN
2734 IF (master) WRITE (stdout,20) trim(vname(1,idragq)), &
2735 & trim(ncname)
2736 exit_flag=2
2737 RETURN
2738 ELSE
2739 piovar_dragq%vd=var_desc(vindex)
2740 piovar_dragq%gtype=r2dvar
2741 END IF
2742# endif
2743# endif
2744
2745
2746
2747 spherical=.false.
2748 IF (find_string(var_name,n_var,'spherical',vindex)) THEN
2749 CALL pio_netcdf_get_lvar (ng, model, ncname, &
2750 & 'spherical', spherical, &
2751 & piofile = grd(ng)%pioFile)
2752 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2753 END IF
2754
2755
2756
2757
2758
2759
2760
2761
2762 DO i=1,4
2763 vsize(i)=0
2764 END DO
2765
2766
2767
2768 IF (master) WRITE (stdout,'(1x)')
2769
2770 DO i=1,n_var
2771
2772 SELECT CASE (trim(adjustl(var_name(i))))
2773
2774
2775
2776 CASE ('xl')
2777 CALL pio_netcdf_get_fvar (ng, model, ncname, &
2778 & 'xl', xl(ng), &
2779 & piofile = grd(ng)%pioFile)
2780 IF (founderror(exit_flag, noerror, __line__, myfile)) EXIT
2781
2782
2783
2784 CASE ('el')
2785 CALL pio_netcdf_get_fvar (ng, model, ncname, &
2786 & 'el', el(ng), &
2787 & piofile = grd(ng)%pioFile)
2788 IF (founderror(exit_flag, noerror, __line__, myfile)) EXIT
2789
2790
2791
2792 CASE ('h')
2793 piovar%vd=var_desc(i)
2794 piovar%gtype=r2dvar
2795 IF (kind(grid(ng)%h).eq.8) THEN
2796 piovar%dkind=pio_double
2797 iodesc => iodesc_dp_r2dvar(ng)
2798 ELSE
2799 piovar%dkind=pio_real
2800 iodesc => iodesc_sp_r2dvar(ng)
2801 END IF
2802
2803 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
2804 & var_name(i), piovar, &
2805 & 0, iodesc, vsize, &
2806 & lbi, ubi, lbj, ubj, &
2807 & fscl, fmin, fmax, &
2808# ifdef MASKING
2809 & grid(ng) % rmask, &
2810# endif
2811# ifdef CHECKSUM
2812 & grid(ng) % h, &
2813 & checksum = fhash)
2814# else
2815 & grid(ng) % h)
2816# endif
2817 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2818 exit_flag=2
2819 ioerror=status
2820 EXIT
2821 ELSE
2822# ifdef SINGLE_PRECISION
2823 hmin(ng)=real(fmin,dp)
2824 hmax(ng)=real(fmax,dp)
2825# else
2826 hmin(ng)=fmin
2827 hmax(ng)=fmax
2828# endif
2829 IF (master) THEN
2830 WRITE (stdout,30) 'bathymetry at RHO-points: h', &
2831 & ng, trim(ncname), hmin(ng), hmax(ng)
2832# ifdef CHECKSUM
2833 WRITE (stdout,60) fhash
2834# endif
2835 END IF
2836 END IF
2837# ifdef NESTING
2838 CALL fill_contact(ng, model, tile, &
2839 & cr, rcontact(cr)%Npoints, rcontact, &
2840 & r2dvar, var_name(i), spval_check, &
2841 & lbi, ubi, lbj, ubj, &
2842 & contact_metric(cr) % h, &
2843 & grid(ng) % h)
2844 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2845# endif
2846 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2847 CALL exchange_r2d_tile (ng, tile, &
2848 & lbi, ubi, lbj, ubj, &
2849 & grid(ng) % h)
2850 END IF
2851# ifdef DISTRIBUTE
2852 CALL mp_exchange2d (ng, tile, model, 1, &
2853 & lbi, ubi, lbj, ubj, &
2854 & nghostpoints, &
2855 & ewperiodic(ng), nsperiodic(ng), &
2856 & grid(ng) % h)
2857# endif
2858# ifdef MASKING
2859
2860
2861
2862 CASE ('mask_rho')
2863 piovar%vd=var_desc(i)
2864 piovar%gtype=r2dvar
2865 IF (kind(grid(ng)%rmask).eq.8) THEN
2866 piovar%dkind=pio_double
2867 iodesc => iodesc_dp_r2dvar(ng)
2868 ELSE
2869 piovar%dkind=pio_real
2870 iodesc => iodesc_sp_r2dvar(ng)
2871 END IF
2872
2873 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
2874 & var_name(i), piovar, &
2875 & 0, iodesc, vsize, &
2876 & lbi, ubi, lbj, ubj, &
2877 & fscl, fmin, fmax, &
2878 & grid(ng) % rmask, &
2879# ifdef CHECKSUM
2880 & grid(ng) % rmask, &
2881 & checksum = fhash)
2882# else
2883 & grid(ng) % rmask)
2884# endif
2885 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2886 exit_flag=2
2887 ioerror=status
2888 EXIT
2889 ELSE
2890 IF (master) THEN
2891 WRITE (stdout,30) 'mask on RHO-points: mask_rho', &
2892 & ng, trim(ncname), fmin, fmax
2893# ifdef CHECKSUM
2894 WRITE (stdout,60) fhash
2895# endif
2896 END IF
2897 END IF
2898# ifdef NESTING
2899 CALL fill_contact(ng, model, tile, &
2900 & cr, rcontact(cr)%Npoints, rcontact, &
2901 & r2dvar, 'rmask', spval_check, &
2902 & lbi, ubi, lbj, ubj, &
2903 & contact_metric(cr) % rmask, &
2904 & grid(ng) % rmask)
2905 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2906# endif
2907 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2908 CALL exchange_r2d_tile (ng, tile, &
2909 & lbi, ubi, lbj, ubj, &
2910 & grid(ng) % rmask)
2911 END IF
2912# ifdef DISTRIBUTE
2913 CALL mp_exchange2d (ng, tile, model, 1, &
2914 & lbi, ubi, lbj, ubj, &
2915 & nghostpoints, &
2916 & ewperiodic(ng), nsperiodic(ng), &
2917 & grid(ng) % rmask)
2918# endif
2919
2920
2921
2922 CASE ('mask_u')
2923 piovar%vd=var_desc(i)
2924 piovar%gtype=u2dvar
2925 IF (kind(grid(ng)%umask).eq.8) THEN
2926 piovar%dkind=pio_double
2927 iodesc => iodesc_dp_u2dvar(ng)
2928 ELSE
2929 piovar%dkind=pio_real
2930 iodesc => iodesc_sp_u2dvar(ng)
2931 END IF
2932
2933 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
2934 & var_name(i), piovar, &
2935 & 0, iodesc, vsize, &
2936 & lbi, ubi, lbj, ubj, &
2937 & fscl, fmin, fmax, &
2938 & grid(ng) % umask, &
2939# ifdef CHECKSUM
2940 & grid(ng) % umask, &
2941 & checksum = fhash)
2942# else
2943 & grid(ng) % umask)
2944# endif
2945 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2946 exit_flag=2
2947 ioerror=status
2948 EXIT
2949 ELSE
2950 IF (master) THEN
2951 WRITE (stdout,30) 'mask on U-points: mask_u', &
2952 & ng, trim(ncname), fmin, fmax
2953# ifdef CHECKSUM
2954 WRITE (stdout,60) fhash
2955# endif
2956 END IF
2957 END IF
2958# ifdef NESTING
2959 CALL fill_contact(ng, model, tile, &
2960 & cr, ucontact(cr)%Npoints, ucontact, &
2961 & u2dvar, 'umask', spval_check, &
2962 & lbi, ubi, lbj, ubj, &
2963 & contact_metric(cr) % umask, &
2964 & grid(ng) % umask)
2965 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2966# endif
2967 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
2968 CALL exchange_u2d_tile (ng, tile, &
2969 & lbi, ubi, lbj, ubj, &
2970 & grid(ng) % umask)
2971 END IF
2972# ifdef DISTRIBUTE
2973 CALL mp_exchange2d (ng, tile, model, 1, &
2974 & lbi, ubi, lbj, ubj, &
2975 & nghostpoints, &
2976 & ewperiodic(ng), nsperiodic(ng), &
2977 & grid(ng) % umask)
2978# endif
2979
2980
2981
2982 CASE ('mask_v')
2983 piovar%vd=var_desc(i)
2984 piovar%gtype=v2dvar
2985 IF (kind(grid(ng)%vmask).eq.8) THEN
2986 piovar%dkind=pio_double
2987 iodesc => iodesc_dp_v2dvar(ng)
2988 ELSE
2989 piovar%dkind=pio_real
2990 iodesc => iodesc_sp_v2dvar(ng)
2991 END IF
2992
2993 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
2994 & var_name(i), piovar, &
2995 & 0, iodesc, vsize, &
2996 & lbi, ubi, lbj, ubj, &
2997 & fscl, fmin, fmax, &
2998 & grid(ng) % vmask, &
2999# ifdef CHECKSUM
3000 & grid(ng) % vmask, &
3001 & checksum = fhash)
3002# else
3003 & grid(ng) % vmask)
3004# endif
3005 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3006 exit_flag=2
3007 ioerror=status
3008 EXIT
3009 ELSE
3010 IF (master) THEN
3011 WRITE (stdout,30) 'mask on V-points: mask_v', &
3012 & ng, trim(ncname), fmin, fmax
3013# ifdef CHECKSUM
3014 WRITE (stdout,60) fhash
3015# endif
3016 END IF
3017 END IF
3018# ifdef NESTING
3019 CALL fill_contact(ng, model, tile, &
3020 & cr, vcontact(cr)%Npoints, vcontact, &
3021 & v2dvar, 'vmask', spval_check, &
3022 & lbi, ubi, lbj, ubj, &
3023 & contact_metric(cr) % vmask, &
3024 & grid(ng) % vmask)
3025 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3026# endif
3027 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3028 CALL exchange_v2d_tile (ng, tile, &
3029 & lbi, ubi, lbj, ubj, &
3030 & grid(ng) % vmask)
3031 END IF
3032# ifdef DISTRIBUTE
3033 CALL mp_exchange2d (ng, tile, model, 1, &
3034 & lbi, ubi, lbj, ubj, &
3035 & nghostpoints, &
3036 & ewperiodic(ng), nsperiodic(ng), &
3037 & grid(ng) % vmask)
3038# endif
3039
3040
3041
3042 CASE ('mask_psi')
3043 piovar%vd=var_desc(i)
3044 piovar%gtype=p2dvar
3045 IF (kind(grid(ng)%pmask).eq.8) THEN
3046 piovar%dkind=pio_double
3047 iodesc => iodesc_dp_p2dvar(ng)
3048 ELSE
3049 piovar%dkind=pio_real
3050 iodesc => iodesc_sp_p2dvar(ng)
3051 END IF
3052
3053 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3054 & var_name(i), piovar, &
3055 & 0, iodesc, vsize, &
3056 & lbi, ubi, lbj, ubj, &
3057 & fscl, fmin, fmax, &
3058 & grid(ng) % pmask, &
3059# ifdef CHECKSUM
3060 & grid(ng) % pmask, &
3061 & checksum = fhash)
3062# else
3063 & grid(ng) % pmask)
3064# endif
3065 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3066 exit_flag=2
3067 ioerror=status
3068 EXIT
3069 ELSE
3070 IF (master) THEN
3071 WRITE (stdout,30) 'mask on PSI-points: mask_psi', &
3072 & ng, trim(ncname), fmin, fmax
3073# ifdef CHECKSUM
3074 WRITE (stdout,60) fhash
3075# endif
3076 END IF
3077 END IF
3078 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3079 CALL exchange_p2d_tile (ng, tile, &
3080 & lbi, ubi, lbj, ubj, &
3081 & grid(ng) % pmask)
3082 END IF
3083# ifdef DISTRIBUTE
3084 CALL mp_exchange2d (ng, tile, model, 1, &
3085 & lbi, ubi, lbj, ubj, &
3086 & nghostpoints, &
3087 & ewperiodic(ng), nsperiodic(ng), &
3088 & grid(ng) % pmask)
3089# endif
3090# endif
3091# ifdef ICESHELF
3092
3093
3094
3095 CASE ('zice')
3096 piovar%vd=var_desc(i)
3097 piovar%gtype=r2dvar
3098 IF (kind(grid(ng)%zice).eq.8) THEN
3099 piovar%dkind=pio_double
3100 iodesc => iodesc_dp_r2dvar(ng)
3101 ELSE
3102 piovar%dkind=pio_real
3103 iodesc => iodesc_sp_r2dvar(ng)
3104 END IF
3105
3106 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3107 & var_name(i), piovar, &
3108 & 0, iodesc, vsize, &
3109 & lbi, ubi, lbj, ubj, &
3110 & fscl, fmin, fmax, &
3111# ifdef MASKING
3112 & grid(ng) % rmask, &
3113# endif
3114# ifdef CHECKSUM
3115 & grid(ng) % zice, &
3116 & checksum = fhash)
3117# else
3118 & grid(ng) % zice)
3119# endif
3120 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3121 exit_flag=2
3122 ioerror=status
3123 EXIT
3124 ELSE
3125 IF (master) THEN
3126 WRITE (stdout,30) 'ice shelf thickness: zice', &
3127 & ng, trim(ncname), fmin, fmax
3128# ifdef CHECKSUM
3129 WRITE (stdout,60) fhash
3130# endif
3131 END IF
3132 END IF
3133 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3134 CALL exchange_r2d_tile (ng, tile, &
3135 & lbi, ubi, lbj, ubj, &
3136 & grid(ng) % zice)
3137 END IF
3138# ifdef DISTRIBUTE
3139 CALL mp_exchange2d (ng, tile, model, 1, &
3140 & lbi, ubi, lbj, ubj, &
3141 & nghostpoints, &
3142 & ewperiodic(ng), nsperiodic(ng), &
3143 & grid(ng) % zice)
3144# endif
3145# endif
3146# if defined WTYPE_GRID && \
3147 (defined
lmd_skpp || defined solar_source) && \
3148
3149
3150
3151
3152 CASE ('wtype_grid')
3153 piovar%vd=var_desc(i)
3154 piovar%gtype=r2dvar
3155 IF (kind(grid(ng)%Jwtype).eq.8) THEN
3156 piovar%dkind=pio_double
3157 iodesc => iodesc_dp_r2dvar(ng)
3158 ELSE
3159 piovar%dkind=pio_real
3160 iodesc => iodesc_sp_r2dvar(ng)
3161 END IF
3162
3163 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3164 & var_name(i), piovar, &
3165 & 0, iodesc, vsize, &
3166 & lbi, ubi, lbj, ubj, &
3167 & fscl, fmin, fmax, &
3168# ifdef MASKING
3169 & grid(ng) % rmask, &
3170# endif
3171# ifdef CHECKSUM
3172 & mixing(ng) % Jwtype, &
3173 & checksum = fhash)
3174# else
3175 & mixing(ng) % Jwtype)
3176# endif
3177 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3178 exit_flag=2
3179 ioerror=status
3180 EXIT
3181 ELSE
3182 IF (master) THEN
3183 WRITE (stdout,30) 'Jerlov water type: wtype_grid', &
3184 & ng, trim(ncname), fmin, fmax
3185# ifdef CHECKSUM
3186 WRITE (stdout,60) fhash
3187# endif
3188 END IF
3189 END IF
3190 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3191 CALL exchange_r2d_tile (ng, tile, &
3192 & lbi, ubi, lbj, ubj, &
3193 & mixing(ng) % Jwtype)
3194 END IF
3195# ifdef DISTRIBUTE
3196 CALL mp_exchange2d (ng, tile, model, 1, &
3197 & lbi, ubi, lbj, ubj, &
3198 & nghostpoints, &
3199 & ewperiodic(ng), nsperiodic(ng), &
3200 & mixing(ng) % Jwtype)
3201# endif
3202# endif
3203# ifndef ANA_SPONGE
3204
3205
3206
3207
3208 CASE ('visc_factor')
3209 IF (luvsponge(ng)) THEN
3210 piovar%vd=var_desc(i)
3211 piovar%gtype=r2dvar
3212 IF (kind(mixing(ng)%visc_factor).eq.8) THEN
3213 piovar%dkind=pio_double
3214 iodesc => iodesc_dp_r2dvar(ng)
3215 ELSE
3216 piovar%dkind=pio_real
3217 iodesc => iodesc_sp_r2dvar(ng)
3218 END IF
3219
3220 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3221 & var_name(i), piovar, &
3222 & 0, iodesc, vsize, &
3223 & lbi, ubi, lbj, ubj, &
3224 & fscl, fmin, fmax, &
3225# ifdef MASKING
3226 & grid(ng) % rmask, &
3227# endif
3228# ifdef CHECKSUM
3229 & mixing(ng) % visc_factor, &
3230 & checksum = fhash)
3231# else
3232 & mixing(ng) % visc_factor)
3233# endif
3234 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3235 exit_flag=2
3236 ioerror=status
3237 EXIT
3238 ELSE
3239 IF (master) THEN
3240 WRITE (stdout,30) 'horizontal viscosity sponge '// &
3241 & 'factor: visc_factor', &
3242 & ng, trim(ncname), fmin, fmax
3243# ifdef CHECKSUM
3244 WRITE (stdout,60) fhash
3245# endif
3246 END IF
3247 END IF
3248 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3249 CALL exchange_r2d_tile (ng, tile, &
3250 & lbi, ubi, lbj, ubj, &
3251 & mixing(ng) % visc_factor)
3252 END IF
3253# ifdef DISTRIBUTE
3254 CALL mp_exchange2d (ng, tile, model, 1, &
3255 & lbi, ubi, lbj, ubj, &
3256 & nghostpoints, &
3257 & ewperiodic(ng), nsperiodic(ng), &
3258 & mixing(ng) % visc_factor)
3259# endif
3260 END IF
3261
3262# ifdef SOLVE3D
3263
3264
3265
3266
3267 CASE ('diff_factor')
3268 IF (any(ltracersponge(:,ng))) THEN
3269 piovar%vd=var_desc(i)
3270 piovar%gtype=r2dvar
3271 IF (kind(mixing(ng)%diff_factor).eq.8) THEN
3272 piovar%dkind=pio_double
3273 iodesc => iodesc_dp_r2dvar(ng)
3274 ELSE
3275 piovar%dkind=pio_real
3276 iodesc => iodesc_sp_r2dvar(ng)
3277 END IF
3278
3279 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3280 & var_name(i), piovar, &
3281 & 0, iodesc, vsize, &
3282 & lbi, ubi, lbj, ubj, &
3283 & fscl, fmin, fmax, &
3284# ifdef MASKING
3285 & grid(ng) % rmask, &
3286# endif
3287# ifdef CHECKSUM
3288 & mixing(ng) % diff_factor, &
3289 & checksum = fhash)
3290# else
3291 & mixing(ng) % diff_factor)
3292# endif
3293 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3294 exit_flag=2
3295 ioerror=status
3296 EXIT
3297 ELSE
3298 IF (master) THEN
3299 WRITE (stdout,30) 'horizontal diffusivity sponge '// &
3300 & 'factor: diff_factor', &
3301 & ng, trim(ncname), fmin, fmax
3302# ifdef CHECKSUM
3303 WRITE (stdout,60) fhash
3304# endif
3305 END IF
3306 END IF
3307 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3308 CALL exchange_r2d_tile (ng, tile, &
3309 & lbi, ubi, lbj, ubj, &
3310 & mixing(ng) % diff_factor)
3311 END IF
3312# ifdef DISTRIBUTE
3313 CALL mp_exchange2d (ng, tile, model, 1, &
3314 & lbi, ubi, lbj, ubj, &
3315 & nghostpoints, &
3316 & ewperiodic(ng), nsperiodic(ng), &
3317 & mixing(ng) % diff_factor)
3318# endif
3319 END IF
3320# endif
3321# endif
3322
3323
3324
3325 CASE ('f')
3326 piovar%vd=var_desc(i)
3327 piovar%gtype=r2dvar
3328 IF (kind(grid(ng)%f).eq.8) THEN
3329 piovar%dkind=pio_double
3330 iodesc => iodesc_dp_r2dvar(ng)
3331 ELSE
3332 piovar%dkind=pio_real
3333 iodesc => iodesc_sp_r2dvar(ng)
3334 END IF
3335
3336 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3337 & var_name(i), piovar, &
3338 & 0, iodesc, vsize, &
3339 & lbi, ubi, lbj, ubj, &
3340 & fscl, fmin, fmax, &
3341# ifdef MASKING
3342 & grid(ng) % rmask, &
3343# endif
3344# ifdef CHECKSUM
3345 & grid(ng) % f, &
3346 & checksum = fhash)
3347# else
3348 & grid(ng) % f)
3349# endif
3350 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3351 exit_flag=2
3352 ioerror=status
3353 EXIT
3354 ELSE
3355 IF (master) THEN
3356 WRITE (stdout,30) 'Coriolis parameter at RHO-points: f',&
3357 & ng, trim(ncname), fmin, fmax
3358# ifdef CHECKSUM
3359 WRITE (stdout,60) fhash
3360# endif
3361 END IF
3362 END IF
3363# ifdef NESTING
3364 CALL fill_contact(ng, model, tile, &
3365 & cr, rcontact(cr)%Npoints, rcontact, &
3366 & r2dvar, var_name(i), spval_check, &
3367 & lbi, ubi, lbj, ubj, &
3368 & contact_metric(cr) % f, &
3369 & grid(ng) % f)
3370 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3371# endif
3372 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3373 CALL exchange_r2d_tile (ng, tile, &
3374 & lbi, ubi, lbj, ubj, &
3375 & grid(ng) % f)
3376 END IF
3377# ifdef DISTRIBUTE
3378 CALL mp_exchange2d (ng, tile, model, 1, &
3379 & lbi, ubi, lbj, ubj, &
3380 & nghostpoints, &
3381 & ewperiodic(ng), nsperiodic(ng), &
3382 & grid(ng) % f)
3383# endif
3384
3385
3386
3387
3388 CASE ('pm')
3389 piovar%vd=var_desc(i)
3390 piovar%gtype=r2dvar
3391 IF (kind(grid(ng)%pm).eq.8) THEN
3392 piovar%dkind=pio_double
3393 iodesc => iodesc_dp_r2dvar(ng)
3394 ELSE
3395 piovar%dkind=pio_real
3396 iodesc => iodesc_sp_r2dvar(ng)
3397 END IF
3398
3399 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3400 & var_name(i), piovar, &
3401 & 0, iodesc, vsize, &
3402 & lbi, ubi, lbj, ubj, &
3403 & fscl, fmin, fmax, &
3404# ifdef MASKING
3405 & grid(ng) % rmask, &
3406# endif
3407# ifdef CHECKSUM
3408 & grid(ng) % pm, &
3409 & checksum = fhash)
3410# else
3411 & grid(ng) % pm)
3412# endif
3413 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3414 exit_flag=2
3415 ioerror=status
3416 EXIT
3417 ELSE
3418 IF (master) THEN
3419 WRITE (stdout,30) 'reciprocal XI-grid spacing: pm', &
3420 & ng, trim(ncname), fmin, fmax
3421# ifdef CHECKSUM
3422 WRITE (stdout,60) fhash
3423# endif
3424 END IF
3425 END IF
3426# ifdef NESTING
3427 CALL fill_contact(ng, model, tile, &
3428 & cr, rcontact(cr)%Npoints, rcontact, &
3429 & r2dvar, var_name(i), spval_check, &
3430 & lbi, ubi, lbj, ubj, &
3431 & contact_metric(cr) % pm, &
3432 & grid(ng) % pm)
3433 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3434# endif
3435 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3436 CALL exchange_r2d_tile (ng, tile, &
3437 & lbi, ubi, lbj, ubj, &
3438 & grid(ng) % pm)
3439 END IF
3440# ifdef DISTRIBUTE
3441 CALL mp_exchange2d (ng, tile, model, 1, &
3442 & lbi, ubi, lbj, ubj, &
3443 & nghostpoints, &
3444 & ewperiodic(ng), nsperiodic(ng), &
3445 & grid(ng) % pm)
3446# endif
3447
3448
3449
3450
3451 CASE ('pn')
3452 piovar%vd=var_desc(i)
3453 piovar%gtype=r2dvar
3454 IF (kind(grid(ng)%pn).eq.8) THEN
3455 piovar%dkind=pio_double
3456 iodesc => iodesc_dp_r2dvar(ng)
3457 ELSE
3458 piovar%dkind=pio_real
3459 iodesc => iodesc_sp_r2dvar(ng)
3460 END IF
3461
3462 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3463 & var_name(i), piovar, &
3464 & 0, iodesc, vsize, &
3465 & lbi, ubi, lbj, ubj, &
3466 & fscl, fmin, fmax, &
3467# ifdef MASKING
3468 & grid(ng) % rmask, &
3469# endif
3470# ifdef CHECKSUM
3471 & grid(ng) % pn, &
3472 & checksum = fhash)
3473# else
3474 & grid(ng) % pn)
3475# endif
3476 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3477 exit_flag=2
3478 ioerror=status
3479 EXIT
3480 ELSE
3481 IF (master) THEN
3482 WRITE (stdout,30) 'reciprocal ETA-grid spacing: pn', &
3483 & ng, trim(ncname), fmin, fmax
3484# ifdef CHECKSUM
3485 WRITE (stdout,60) fhash
3486# endif
3487 END IF
3488 END IF
3489# ifdef NESTING
3490 CALL fill_contact(ng, model, tile, &
3491 & cr, rcontact(cr)%Npoints, rcontact, &
3492 & r2dvar, var_name(i), spval_check, &
3493 & lbi, ubi, lbj, ubj, &
3494 & contact_metric(cr) % pn, &
3495 & grid(ng) % pn)
3496 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3497# endif
3498 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3499 CALL exchange_r2d_tile (ng, tile, &
3500 & lbi, ubi, lbj, ubj, &
3501 & grid(ng) % pn)
3502 END IF
3503# ifdef DISTRIBUTE
3504 CALL mp_exchange2d (ng, tile, model, 1, &
3505 & lbi, ubi, lbj, ubj, &
3506 & nghostpoints, &
3507 & ewperiodic(ng), nsperiodic(ng), &
3508 & grid(ng) % pn)
3509# endif
3510# if (defined CURVGRID && defined UV_ADV)
3511
3512
3513
3514 CASE ('dmde')
3515 piovar%vd=var_desc(i)
3516 piovar%gtype=r2dvar
3517 IF (kind(grid(ng)%dmde).eq.8) THEN
3518 piovar%dkind=pio_double
3519 iodesc => iodesc_dp_r2dvar(ng)
3520 ELSE
3521 piovar%dkind=pio_real
3522 iodesc => iodesc_sp_r2dvar(ng)
3523 END IF
3524
3525 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3526 & var_name(i), piovar, &
3527 & 0, iodesc, vsize, &
3528 & lbi, ubi, lbj, ubj, &
3529 & fscl, fmin, fmax, &
3530# ifdef MASKING
3531 & grid(ng) % rmask, &
3532# endif
3533# ifdef CHECKSUM
3534 & grid(ng) % dmde, &
3535 & checksum = fhash)
3536# else
3537 & grid(ng) % dmde)
3538# endif
3539 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3540 exit_flag=2
3541 ioerror=status
3542 EXIT
3543 ELSE
3544 IF (master) THEN
3545 WRITE (stdout,30) 'ETA-derivative of inverse metric '// &
3546 & 'factor pm: dmde', &
3547 & ng, trim(ncname), fmin, fmax
3548# ifdef CHECKSUM
3549 WRITE (stdout,60) fhash
3550# endif
3551 END IF
3552 END IF
3553# ifdef NESTING
3554 CALL fill_contact(ng, model, tile, &
3555 & cr, rcontact(cr)%Npoints, rcontact, &
3556 & r2dvar, var_name(i), spval_check, &
3557 & lbi, ubi, lbj, ubj, &
3558 & contact_metric(cr) % dmde, &
3559 & grid(ng) % dmde)
3560 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3561# endif
3562 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3563 CALL exchange_r2d_tile (ng, tile, &
3564 & lbi, ubi, lbj, ubj, &
3565 & grid(ng) % dmde)
3566 END IF
3567# ifdef DISTRIBUTE
3568 CALL mp_exchange2d (ng, tile, model, 1, &
3569 & lbi, ubi, lbj, ubj, &
3570 & nghostpoints, &
3571 & ewperiodic(ng), nsperiodic(ng), &
3572 & grid(ng) % dmde)
3573# endif
3574
3575
3576
3577 CASE ('dndx')
3578 piovar%vd=var_desc(i)
3579 piovar%gtype=r2dvar
3580 IF (kind(grid(ng)%dndx).eq.8) THEN
3581 piovar%dkind=pio_double
3582 iodesc => iodesc_dp_r2dvar(ng)
3583 ELSE
3584 piovar%dkind=pio_real
3585 iodesc => iodesc_sp_r2dvar(ng)
3586 END IF
3587
3588 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3589 & var_name(i), piovar, &
3590 & 0, iodesc, vsize, &
3591 & lbi, ubi, lbj, ubj, &
3592 & fscl, fmin, fmax, &
3593# ifdef MASKING
3594 & grid(ng) % rmask, &
3595# endif
3596# ifdef CHECKSUM
3597 & grid(ng) % dndx, &
3598 & checksum = fhash)
3599# else
3600 & grid(ng) % dndx)
3601# endif
3602 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3603 exit_flag=2
3604 ioerror=status
3605 EXIT
3606 ELSE
3607 IF (master) THEN
3608 WRITE (stdout,30) 'XI-derivative of inverse metric '// &
3609 & 'factor pn: dndx', &
3610 & ng, trim(ncname), fmin, fmax
3611# ifdef CHECKSUM
3612 WRITE (stdout,60) fhash
3613# endif
3614 END IF
3615 END IF
3616# ifdef NESTING
3617 CALL fill_contact(ng, model, tile, &
3618 & cr, rcontact(cr)%Npoints, rcontact, &
3619 & r2dvar, var_name(i), spval_check, &
3620 & lbi, ubi, lbj, ubj, &
3621 & contact_metric(cr) % dndx, &
3622 & grid(ng) % dndx)
3623 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3624# endif
3625 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
3626 CALL exchange_r2d_tile (ng, tile, &
3627 & lbi, ubi, lbj, ubj, &
3628 & grid(ng) % dndx)
3629 END IF
3630# ifdef DISTRIBUTE
3631 CALL mp_exchange2d (ng, tile, model, 1, &
3632 & lbi, ubi, lbj, ubj, &
3633 & nghostpoints, &
3634 & ewperiodic(ng), nsperiodic(ng), &
3635 & grid(ng) % dndx)
3636# endif
3637# endif
3638
3639
3640
3641 CASE ('x_psi')
3642 piovar%vd=var_desc(i)
3643 piovar%gtype=p2dvar
3644 IF (kind(grid(ng)%xp).eq.8) THEN
3645 piovar%dkind=pio_double
3646 iodesc => iodesc_dp_p2dvar(ng)
3647 ELSE
3648 piovar%dkind=pio_real
3649 iodesc => iodesc_sp_p2dvar(ng)
3650 END IF
3651
3652 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3653 & var_name(i), piovar, &
3654 & 0, iodesc, vsize, &
3655 & lbi, ubi, lbj, ubj, &
3656 & fscl, fmin, fmax, &
3657# ifdef MASKING
3658 & grid(ng) % pmask, &
3659# endif
3660# ifdef CHECKSUM
3661 & grid(ng) % xp, &
3662 & checksum = fhash)
3663# else
3664 & grid(ng) % xp)
3665# endif
3666 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3667 exit_flag=2
3668 ioerror=status
3669 EXIT
3670 ELSE
3671 IF (master) THEN
3672 WRITE (stdout,30) 'x-location of PSI-points: x_psi', &
3673 & ng, trim(ncname), fmin, fmax
3674# ifdef CHECKSUM
3675 WRITE (stdout,60) fhash
3676# endif
3677 END IF
3678 END IF
3679# ifdef DISTRIBUTE
3680 CALL mp_exchange2d (ng, tile, model, 1, &
3681 & lbi, ubi, lbj, ubj, &
3682 & nghostpoints, &
3683 & .false., .false., &
3684 & grid(ng) % xp)
3685# endif
3686
3687
3688
3689 CASE ('y_psi')
3690 piovar%vd=var_desc(i)
3691 piovar%gtype=p2dvar
3692 IF (kind(grid(ng)%yp).eq.8) THEN
3693 piovar%dkind=pio_double
3694 iodesc => iodesc_dp_p2dvar(ng)
3695 ELSE
3696 piovar%dkind=pio_real
3697 iodesc => iodesc_sp_p2dvar(ng)
3698 END IF
3699
3700 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3701 & var_name(i), piovar, &
3702 & 0, iodesc, vsize, &
3703 & lbi, ubi, lbj, ubj, &
3704 & fscl, fmin, fmax, &
3705# ifdef MASKING
3706 & grid(ng) % pmask, &
3707# endif
3708# ifdef CHECKSUM
3709 & grid(ng) % yp, &
3710 & checksum = fhash)
3711# else
3712 & grid(ng) % yp)
3713# endif
3714 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3715 exit_flag=2
3716 ioerror=status
3717 EXIT
3718 ELSE
3719 IF (master) THEN
3720 WRITE (stdout,30) 'y-location of PSI-points: y-psi', &
3721 & ng, trim(ncname), fmin, fmax
3722# ifdef CHECKSUM
3723 WRITE (stdout,60) fhash
3724# endif
3725 END IF
3726 END IF
3727# ifdef DISTRIBUTE
3728 CALL mp_exchange2d (ng, tile, model, 1, &
3729 & lbi, ubi, lbj, ubj, &
3730 & nghostpoints, &
3731 & .false., .false., &
3732 & grid(ng) % yp)
3733# endif
3734
3735
3736
3737 CASE ('x_rho')
3738 piovar%vd=var_desc(i)
3739 piovar%gtype=r2dvar
3740 IF (kind(grid(ng)%xr).eq.8) THEN
3741 piovar%dkind=pio_double
3742 iodesc => iodesc_dp_r2dvar(ng)
3743 ELSE
3744 piovar%dkind=pio_real
3745 iodesc => iodesc_sp_r2dvar(ng)
3746 END IF
3747
3748 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3749 & var_name(i), piovar, &
3750 & 0, iodesc, vsize, &
3751 & lbi, ubi, lbj, ubj, &
3752 & fscl, fmin, fmax, &
3753# ifdef MASKING
3754 & grid(ng) % rmask, &
3755# endif
3756# ifdef CHECKSUM
3757 & grid(ng) % xr, &
3758 & checksum = fhash)
3759# else
3760 & grid(ng) % xr)
3761# endif
3762 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3763 exit_flag=2
3764 ioerror=status
3765 EXIT
3766 ELSE
3767 IF (master) THEN
3768 WRITE (stdout,30) 'x-location of RHO-points: x-rho', &
3769 & ng, trim(ncname), fmin, fmax
3770# ifdef CHECKSUM
3771 WRITE (stdout,60) fhash
3772# endif
3773 END IF
3774 END IF
3775# ifdef NESTING
3776 IF (.not.spherical) THEN
3777 CALL fill_contact(ng, model, tile, &
3778 & cr, rcontact(cr)%Npoints, rcontact, &
3779 & r2dvar, var_name(i), spval_check, &
3780 & lbi, ubi, lbj, ubj, &
3781 & contact_metric(cr) % Xr, &
3782 & grid(ng) % xr)
3783 IF (founderror(exit_flag, noerror, &
3784 & __line__, myfile)) RETURN
3785 END IF
3786# endif
3787# ifdef DISTRIBUTE
3788 CALL mp_exchange2d (ng, tile, model, 1, &
3789 & lbi, ubi, lbj, ubj, &
3790 & nghostpoints, &
3791 & .false., .false., &
3792 & grid(ng) % xr)
3793# endif
3794
3795
3796
3797 CASE ('y_rho')
3798 piovar%vd=var_desc(i)
3799 piovar%gtype=r2dvar
3800 IF (kind(grid(ng)%yr).eq.8) THEN
3801 piovar%dkind=pio_double
3802 iodesc => iodesc_dp_r2dvar(ng)
3803 ELSE
3804 piovar%dkind=pio_real
3805 iodesc => iodesc_sp_r2dvar(ng)
3806 END IF
3807
3808 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3809 & var_name(i), piovar, &
3810 & 0, iodesc, vsize, &
3811 & lbi, ubi, lbj, ubj, &
3812 & fscl, fmin, fmax, &
3813# ifdef MASKING
3814 & grid(ng) % rmask, &
3815# endif
3816# ifdef CHECKSUM
3817 & grid(ng) % yr, &
3818 & checksum = fhash)
3819# else
3820 & grid(ng) % yr)
3821# endif
3822 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3823 exit_flag=2
3824 ioerror=status
3825 EXIT
3826 ELSE
3827 IF (master) THEN
3828 WRITE (stdout,30) 'y-location of RHO-points: y_rho', &
3829 & ng, trim(ncname), fmin, fmax
3830# ifdef CHECKSUM
3831 WRITE (stdout,60) fhash
3832# endif
3833 END IF
3834 END IF
3835# ifdef NESTING
3836 IF (.not.spherical) THEN
3837 CALL fill_contact(ng, model, tile, &
3838 & cr, rcontact(cr)%Npoints, rcontact, &
3839 & r2dvar, var_name(i), spval_check, &
3840 & lbi, ubi, lbj, ubj, &
3841 & contact_metric(cr) % Yr, &
3842 & grid(ng) % yr)
3843 IF (founderror(exit_flag, noerror, &
3844 & __line__, myfile)) RETURN
3845 END IF
3846# endif
3847# ifdef DISTRIBUTE
3848 CALL mp_exchange2d (ng, tile, model, 1, &
3849 & lbi, ubi, lbj, ubj, &
3850 & nghostpoints, &
3851 & .false., .false., &
3852 & grid(ng) % yr)
3853# endif
3854
3855
3856
3857 CASE ('x_u')
3858 piovar%vd=var_desc(i)
3859 piovar%gtype=u2dvar
3860 IF (kind(grid(ng)%xu).eq.8) THEN
3861 piovar%dkind=pio_double
3862 iodesc => iodesc_dp_u2dvar(ng)
3863 ELSE
3864 piovar%dkind=pio_real
3865 iodesc => iodesc_sp_u2dvar(ng)
3866 END IF
3867
3868 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3869 & var_name(i), piovar, &
3870 & 0, iodesc, vsize, &
3871 & lbi, ubi, lbj, ubj, &
3872 & fscl, fmin, fmax, &
3873# ifdef MASKING
3874 & grid(ng) % umask, &
3875# endif
3876# ifdef CHECKSUM
3877 & grid(ng) % xu, &
3878 & checksum = fhash)
3879# else
3880 & grid(ng) % xu)
3881# endif
3882 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3883 exit_flag=2
3884 ioerror=status
3885 EXIT
3886 ELSE
3887 IF (master) THEN
3888 WRITE (stdout,30) 'x-location of U-points: x_u', &
3889 & ng, trim(ncname), fmin, fmax
3890# ifdef CHECKSUM
3891 WRITE (stdout,60) fhash
3892# endif
3893 END IF
3894 END IF
3895# ifdef NESTING
3896 IF (.not.spherical) THEN
3897 CALL fill_contact(ng, model, tile, &
3898 & cr, ucontact(cr)%Npoints, ucontact, &
3899 & u2dvar, var_name(i), spval_check, &
3900 & lbi, ubi, lbj, ubj, &
3901 & contact_metric(cr) % Xu, &
3902 & grid(ng) % xu)
3903 IF (founderror(exit_flag, noerror, &
3904 & __line__, myfile)) RETURN
3905 END IF
3906# endif
3907# ifdef DISTRIBUTE
3908 CALL mp_exchange2d (ng, tile, model, 1, &
3909 & lbi, ubi, lbj, ubj, &
3910 & nghostpoints, &
3911 & .false., .false., &
3912 & grid(ng) % xu)
3913# endif
3914
3915
3916
3917 CASE ('y_u')
3918 piovar%vd=var_desc(i)
3919 piovar%gtype=u2dvar
3920 IF (kind(grid(ng)%yu).eq.8) THEN
3921 piovar%dkind=pio_double
3922 iodesc => iodesc_dp_u2dvar(ng)
3923 ELSE
3924 piovar%dkind=pio_real
3925 iodesc => iodesc_sp_u2dvar(ng)
3926 END IF
3927
3928 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3929 & var_name(i), piovar, &
3930 & 0, iodesc, vsize, &
3931 & lbi, ubi, lbj, ubj, &
3932 & fscl, fmin, fmax, &
3933# ifdef MASKING
3934 & grid(ng) % umask, &
3935# endif
3936# ifdef CHECKSUM
3937 & grid(ng) % yu, &
3938 & checksum = fhash)
3939# else
3940 & grid(ng) % yu)
3941# endif
3942 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3943 exit_flag=2
3944 ioerror=status
3945 EXIT
3946 ELSE
3947 IF (master) THEN
3948 WRITE (stdout,30) 'y-location of U-points: y_u', &
3949 & ng, trim(ncname), fmin, fmax
3950# ifdef CHECKSUM
3951 WRITE (stdout,60) fhash
3952# endif
3953 END IF
3954 END IF
3955# ifdef NESTING
3956 IF (.not.spherical) THEN
3957 CALL fill_contact(ng, model, tile, &
3958 & cr, ucontact(cr)%Npoints, ucontact, &
3959 & u2dvar, var_name(i), spval_check, &
3960 & lbi, ubi, lbj, ubj, &
3961 & contact_metric(cr) % Yu, &
3962 & grid(ng) % yu)
3963 IF (founderror(exit_flag, noerror, &
3964 & __line__, myfile)) RETURN
3965 END IF
3966# endif
3967# ifdef DISTRIBUTE
3968 CALL mp_exchange2d (ng, tile, model, 1, &
3969 & lbi, ubi, lbj, ubj, &
3970 & nghostpoints, &
3971 & .false., .false., &
3972 & grid(ng) % yu)
3973# endif
3974
3975
3976
3977 CASE ('x_v')
3978 piovar%vd=var_desc(i)
3979 piovar%gtype=v2dvar
3980 IF (kind(grid(ng)%xv).eq.8) THEN
3981 piovar%dkind=pio_double
3982 iodesc => iodesc_dp_v2dvar(ng)
3983 ELSE
3984 piovar%dkind=pio_real
3985 iodesc => iodesc_sp_v2dvar(ng)
3986 END IF
3987
3988 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
3989 & var_name(i), piovar, &
3990 & 0, iodesc, vsize, &
3991 & lbi, ubi, lbj, ubj, &
3992 & fscl, fmin, fmax, &
3993# ifdef MASKING
3994 & grid(ng) % vmask, &
3995# endif
3996# ifdef CHECKSUM
3997 & grid(ng) % xv, &
3998 & checksum = fhash)
3999# else
4000 & grid(ng) % xv)
4001# endif
4002 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4003 exit_flag=2
4004 ioerror=status
4005 EXIT
4006 ELSE
4007 IF (master) THEN
4008 WRITE (stdout,30) 'x-location of V-points: x_v', &
4009 & ng, trim(ncname), fmin, fmax
4010# ifdef CHECKSUM
4011 WRITE (stdout,60) fhash
4012# endif
4013 END IF
4014 END IF
4015# ifdef NESTING
4016 IF (.not.spherical) THEN
4017 CALL fill_contact(ng, model, tile, &
4018 & cr, vcontact(cr)%Npoints, vcontact, &
4019 & v2dvar, var_name(i), spval_check, &
4020 & lbi, ubi, lbj, ubj, &
4021 & contact_metric(cr) % Xv, &
4022 & grid(ng) % xv)
4023 IF (founderror(exit_flag, noerror, &
4024 & __line__, myfile)) RETURN
4025 END IF
4026# endif
4027# ifdef DISTRIBUTE
4028 CALL mp_exchange2d (ng, tile, model, 1, &
4029 & lbi, ubi, lbj, ubj, &
4030 & nghostpoints, &
4031 & .false., .false., &
4032 & grid(ng) % xv)
4033# endif
4034
4035
4036
4037 CASE ('y_v')
4038 piovar%vd=var_desc(i)
4039 piovar%gtype=v2dvar
4040 IF (kind(grid(ng)%yv).eq.8) THEN
4041 piovar%dkind=pio_double
4042 iodesc => iodesc_dp_v2dvar(ng)
4043 ELSE
4044 piovar%dkind=pio_real
4045 iodesc => iodesc_sp_v2dvar(ng)
4046 END IF
4047
4048 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4049 & var_name(i), piovar, &
4050 & 0, iodesc, vsize, &
4051 & lbi, ubi, lbj, ubj, &
4052 & fscl, fmin, fmax, &
4053# ifdef MASKING
4054 & grid(ng) % vmask, &
4055# endif
4056# ifdef CHECKSUM
4057 & grid(ng) % yv, &
4058 & checksum = fhash)
4059# else
4060 & grid(ng) % yv)
4061# endif
4062 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4063 exit_flag=2
4064 ioerror=status
4065 EXIT
4066 ELSE
4067 IF (master) THEN
4068 WRITE (stdout,30) 'y-location of V-points: y_v', &
4069 & ng, trim(ncname), fmin, fmax
4070# ifdef CHECKSUM
4071 WRITE (stdout,60) fhash
4072# endif
4073 END IF
4074 END IF
4075# ifdef NESTING
4076 IF (.not.spherical) THEN
4077 CALL fill_contact(ng, model, tile, &
4078 & cr, vcontact(cr)%Npoints, vcontact, &
4079 & v2dvar, var_name(i), spval_check, &
4080 & lbi, ubi, lbj, ubj, &
4081 & contact_metric(cr) % Yv, &
4082 & grid(ng) % yv)
4083 IF (founderror(exit_flag, noerror, &
4084 & __line__, myfile)) RETURN
4085 END IF
4086# endif
4087# ifdef DISTRIBUTE
4088 CALL mp_exchange2d (ng, tile, model, 1, &
4089 & lbi, ubi, lbj, ubj, &
4090 & nghostpoints, &
4091 & .false., .false., &
4092 & grid(ng) % yv)
4093# endif
4094
4095
4096
4097 CASE ('lon_psi')
4098 IF (spherical) THEN
4099 piovar%vd=var_desc(i)
4100 piovar%gtype=p2dvar
4101 IF (kind(grid(ng)%lonp).eq.8) THEN
4102 piovar%dkind=pio_double
4103 iodesc => iodesc_dp_p2dvar(ng)
4104 ELSE
4105 piovar%dkind=pio_real
4106 iodesc => iodesc_sp_p2dvar(ng)
4107 END IF
4108
4109 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4110 & var_name(i), piovar, &
4111 & 0, iodesc, vsize, &
4112 & lbi, ubi, lbj, ubj, &
4113 & fscl, fmin, fmax, &
4114# ifdef MASKING
4115 & grid(ng) % pmask, &
4116# endif
4117# ifdef CHECKSUM
4118 & grid(ng) % lonp, &
4119 & checksum = fhash)
4120# else
4121 & grid(ng) % lonp)
4122# endif
4123 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4124 exit_flag=2
4125 ioerror=status
4126 EXIT
4127 ELSE
4128 IF (master) THEN
4129 WRITE (stdout,30) 'longitude of PSI-points: lon_psi', &
4130 & ng, trim(ncname), fmin, fmax
4131# ifdef CHECKSUM
4132 WRITE (stdout,60) fhash
4133# endif
4134 END IF
4135 END IF
4136# ifdef DISTRIBUTE
4137 CALL mp_exchange2d (ng, tile, model, 1, &
4138 & lbi, ubi, lbj, ubj, &
4139 & nghostpoints, &
4140 & .false., .false., &
4141 & grid(ng) % lonp)
4142# endif
4143 END IF
4144
4145
4146
4147 CASE ('lat_psi')
4148 IF (spherical) THEN
4149 piovar%vd=var_desc(i)
4150 piovar%gtype=p2dvar
4151 IF (kind(grid(ng)%latp).eq.8) THEN
4152 piovar%dkind=pio_double
4153 iodesc => iodesc_dp_p2dvar(ng)
4154 ELSE
4155 piovar%dkind=pio_real
4156 iodesc => iodesc_sp_p2dvar(ng)
4157 END IF
4158
4159 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4160 & var_name(i), piovar, &
4161 & 0, iodesc, vsize, &
4162 & lbi, ubi, lbj, ubj, &
4163 & fscl, fmin, fmax, &
4164# ifdef MASKING
4165 & grid(ng) % pmask, &
4166# endif
4167# ifdef CHECKSUM
4168 & grid(ng) % latp, &
4169 & checksum = fhash)
4170# else
4171 & grid(ng) % latp)
4172# endif
4173 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4174 exit_flag=2
4175 ioerror=status
4176 EXIT
4177 ELSE
4178 IF (master) THEN
4179 WRITE (stdout,30) 'latitude of PSI-points lat_psi', &
4180 & ng, trim(ncname), fmin, fmax
4181# ifdef CHECKSUM
4182 WRITE (stdout,60) fhash
4183# endif
4184 END IF
4185 END IF
4186# ifdef DISTRIBUTE
4187 CALL mp_exchange2d (ng, tile, model, 1, &
4188 & lbi, ubi, lbj, ubj, &
4189 & nghostpoints, &
4190 & .false., .false., &
4191 & grid(ng) % latp)
4192# endif
4193 END IF
4194
4195
4196
4197 CASE ('lon_rho')
4198 IF (spherical) THEN
4199 piovar%vd=var_desc(i)
4200 piovar%gtype=r2dvar
4201 IF (kind(grid(ng)%lonr).eq.8) THEN
4202 piovar%dkind=pio_double
4203 iodesc => iodesc_dp_r2dvar(ng)
4204 ELSE
4205 piovar%dkind=pio_real
4206 iodesc => iodesc_sp_r2dvar(ng)
4207 END IF
4208
4209 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4210 & var_name(i), piovar, &
4211 & 0, iodesc, vsize, &
4212 & lbi, ubi, lbj, ubj, &
4213 & fscl, lonmin(ng), lonmax(ng), &
4214# ifdef MASKING
4215 & grid(ng) % rmask, &
4216# endif
4217# ifdef CHECKSUM
4218 & grid(ng) % lonr, &
4219 & checksum = fhash)
4220# else
4221 & grid(ng) % lonr)
4222# endif
4223 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4224 exit_flag=2
4225 ioerror=status
4226 EXIT
4227 ELSE
4228 IF (master) THEN
4229 WRITE (stdout,30) 'longitude of RHO-points: lon_rho', &
4230 & ng, trim(ncname), &
4231 & lonmin(ng), lonmax(ng)
4232# ifdef CHECKSUM
4233 WRITE (stdout,60) fhash
4234# endif
4235 END IF
4236 END IF
4237# ifdef NESTING
4238 CALL fill_contact(ng, model, tile, &
4239 & cr, rcontact(cr)%Npoints, rcontact, &
4240 & r2dvar, var_name(i), spval_check, &
4241 & lbi, ubi, lbj, ubj, &
4242 & contact_metric(cr) % Xr, &
4243 & grid(ng) % lonr)
4244 IF (founderror(exit_flag, noerror, &
4245 & __line__, myfile)) RETURN
4246# endif
4247# ifdef DISTRIBUTE
4248 CALL mp_exchange2d (ng, tile, model, 1, &
4249 & lbi, ubi, lbj, ubj, &
4250 & nghostpoints, &
4251 & .false., .false., &
4252 & grid(ng) % lonr)
4253# endif
4254 END IF
4255
4256
4257
4258 CASE ('lat_rho')
4259 IF (spherical) THEN
4260 piovar%vd=var_desc(i)
4261 piovar%gtype=r2dvar
4262 IF (kind(grid(ng)%latr).eq.8) THEN
4263 piovar%dkind=pio_double
4264 iodesc => iodesc_dp_r2dvar(ng)
4265 ELSE
4266 piovar%dkind=pio_real
4267 iodesc => iodesc_sp_r2dvar(ng)
4268 END IF
4269
4270 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4271 & var_name(i), piovar, &
4272 & 0, iodesc, vsize, &
4273 & lbi, ubi, lbj, ubj, &
4274 & fscl, latmin(ng), latmax(ng), &
4275# ifdef MASKING
4276 & grid(ng) % rmask, &
4277# endif
4278# ifdef CHECKSUM
4279 & grid(ng) % latr, &
4280 & checksum = fhash)
4281# else
4282 & grid(ng) % latr)
4283# endif
4284 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4285 exit_flag=2
4286 ioerror=status
4287 EXIT
4288 ELSE
4289 IF (master) THEN
4290 WRITE (stdout,30) 'latitude of RHO-points lat_rho', &
4291 & ng, trim(ncname), &
4292 & latmin(ng), latmax(ng)
4293# ifdef CHECKSUM
4294 WRITE (stdout,60) fhash
4295# endif
4296 END IF
4297 END IF
4298# ifdef NESTING
4299 CALL fill_contact(ng, model, tile, &
4300 & cr, rcontact(cr)%Npoints, rcontact, &
4301 & r2dvar, var_name(i), spval_check, &
4302 & lbi, ubi, lbj, ubj, &
4303 & contact_metric(cr) % Yr, &
4304 & grid(ng) % latr)
4305 IF (founderror(exit_flag, noerror, &
4306 & __line__, myfile)) RETURN
4307# endif
4308# ifdef DISTRIBUTE
4309 CALL mp_exchange2d (ng, tile, model, 1, &
4310 & lbi, ubi, lbj, ubj, &
4311 & nghostpoints, &
4312 & .false., .false., &
4313 & grid(ng) % latr)
4314# endif
4315 END IF
4316
4317
4318
4319 CASE ('lon_u')
4320 IF (spherical) THEN
4321 piovar%vd=var_desc(i)
4322 piovar%gtype=u2dvar
4323 IF (kind(grid(ng)%lonu).eq.8) THEN
4324 piovar%dkind=pio_double
4325 iodesc => iodesc_dp_u2dvar(ng)
4326 ELSE
4327 piovar%dkind=pio_real
4328 iodesc => iodesc_sp_u2dvar(ng)
4329 END IF
4330
4331 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4332 & var_name(i), piovar, &
4333 & 0, iodesc, vsize, &
4334 & lbi, ubi, lbj, ubj, &
4335 & fscl, fmin, fmax, &
4336# ifdef MASKING
4337 & grid(ng) % umask, &
4338# endif
4339# ifdef CHECKSUM
4340 & grid(ng) % lonu, &
4341 & checksum = fhash)
4342# else
4343 & grid(ng) % lonu)
4344# endif
4345 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4346 exit_flag=2
4347 ioerror=status
4348 EXIT
4349 ELSE
4350 IF (master) THEN
4351 WRITE (stdout,30) 'longitude of U-points: lon_u', &
4352 & ng, trim(ncname), fmin, fmax
4353# ifdef CHECKSUM
4354 WRITE (stdout,60) fhash
4355# endif
4356 END IF
4357 END IF
4358# ifdef NESTING
4359 CALL fill_contact(ng, model, tile, &
4360 & cr, ucontact(cr)%Npoints, ucontact, &
4361 & u2dvar, var_name(i), spval_check, &
4362 & lbi, ubi, lbj, ubj, &
4363 & contact_metric(cr) % Xu, &
4364 & grid(ng) % lonu)
4365 IF (founderror(exit_flag, noerror, &
4366 & __line__, myfile)) RETURN
4367# endif
4368# ifdef DISTRIBUTE
4369 CALL mp_exchange2d (ng, tile, model, 1, &
4370 & lbi, ubi, lbj, ubj, &
4371 & nghostpoints, &
4372 & .false., .false., &
4373 & grid(ng) % lonu)
4374# endif
4375 END IF
4376
4377
4378
4379 CASE ('lat_u')
4380 IF (spherical) THEN
4381 piovar%vd=var_desc(i)
4382 piovar%gtype=u2dvar
4383 IF (kind(grid(ng)%latu).eq.8) THEN
4384 piovar%dkind=pio_double
4385 iodesc => iodesc_dp_u2dvar(ng)
4386 ELSE
4387 piovar%dkind=pio_real
4388 iodesc => iodesc_sp_u2dvar(ng)
4389 END IF
4390
4391 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4392 & var_name(i), piovar, &
4393 & 0, iodesc, vsize, &
4394 & lbi, ubi, lbj, ubj, &
4395 & fscl, fmin, fmax, &
4396# ifdef MASKING
4397 & grid(ng) % umask, &
4398# endif
4399# ifdef CHECKSUM
4400 & grid(ng) % latu, &
4401 & checksum = fhash)
4402# else
4403 & grid(ng) % latu)
4404# endif
4405 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4406 exit_flag=2
4407 ioerror=status
4408 EXIT
4409 ELSE
4410 IF (master) THEN
4411 WRITE (stdout,30) 'latitude of U-points: lat_u', &
4412 & ng, trim(ncname), fmin, fmax
4413# ifdef CHECKSUM
4414 WRITE (stdout,60) fhash
4415# endif
4416 END IF
4417 END IF
4418# ifdef NESTING
4419 CALL fill_contact(ng, model, tile, &
4420 & cr, ucontact(cr)%Npoints, ucontact, &
4421 & u2dvar, var_name(i), spval_check, &
4422 & lbi, ubi, lbj, ubj, &
4423 & contact_metric(cr) % Yu, &
4424 & grid(ng) % latu)
4425 IF (founderror(exit_flag, noerror, &
4426 & __line__, myfile)) RETURN
4427# endif
4428# ifdef DISTRIBUTE
4429 CALL mp_exchange2d (ng, tile, model, 1, &
4430 & lbi, ubi, lbj, ubj, &
4431 & nghostpoints, &
4432 & .false., .false., &
4433 & grid(ng) % latu)
4434# endif
4435 END IF
4436
4437
4438
4439 CASE ('lon_v')
4440 IF (spherical) THEN
4441 piovar%vd=var_desc(i)
4442 piovar%gtype=v2dvar
4443 IF (kind(grid(ng)%lonv).eq.8) THEN
4444 piovar%dkind=pio_double
4445 iodesc => iodesc_dp_v2dvar(ng)
4446 ELSE
4447 piovar%dkind=pio_real
4448 iodesc => iodesc_sp_v2dvar(ng)
4449 END IF
4450
4451 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4452 & var_name(i), piovar, &
4453 & 0, iodesc, vsize, &
4454 & lbi, ubi, lbj, ubj, &
4455 & fscl, fmin, fmax, &
4456# ifdef MASKING
4457 & grid(ng) % vmask, &
4458# endif
4459# ifdef CHECKSUM
4460 & grid(ng) % lonv, &
4461 & checksum = fhash)
4462# else
4463 & grid(ng) % lonv)
4464# endif
4465 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4466 exit_flag=2
4467 ioerror=status
4468 EXIT
4469 ELSE
4470 IF (master) THEN
4471 WRITE (stdout,30) 'longitude of V-points: lon_v', &
4472 & ng, trim(ncname), fmin, fmax
4473# ifdef CHECKSUM
4474 WRITE (stdout,60) fhash
4475# endif
4476 END IF
4477 END IF
4478# ifdef NESTING
4479 CALL fill_contact(ng, model, tile, &
4480 & cr, vcontact(cr)%Npoints, vcontact, &
4481 & v2dvar, var_name(i), spval_check, &
4482 & lbi, ubi, lbj, ubj, &
4483 & contact_metric(cr) % Xv, &
4484 & grid(ng) % lonv)
4485 IF (founderror(exit_flag, noerror, &
4486 & __line__, myfile)) RETURN
4487# endif
4488# ifdef DISTRIBUTE
4489 CALL mp_exchange2d (ng, tile, model, 1, &
4490 & lbi, ubi, lbj, ubj, &
4491 & nghostpoints, &
4492 & .false., .false., &
4493 & grid(ng) % lonv)
4494# endif
4495 END IF
4496
4497
4498
4499 CASE ('lat_v')
4500 IF (spherical) THEN
4501 piovar%vd=var_desc(i)
4502 piovar%gtype=v2dvar
4503 IF (kind(grid(ng)%latv).eq.8) THEN
4504 piovar%dkind=pio_double
4505 iodesc => iodesc_dp_v2dvar(ng)
4506 ELSE
4507 piovar%dkind=pio_real
4508 iodesc => iodesc_sp_v2dvar(ng)
4509 END IF
4510
4511 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4512 & var_name(i), piovar, &
4513 & 0, iodesc, vsize, &
4514 & lbi, ubi, lbj, ubj, &
4515 & fscl, fmin, fmax, &
4516# ifdef MASKING
4517 & grid(ng) % vmask, &
4518# endif
4519# ifdef CHECKSUM
4520 & grid(ng) % latv, &
4521 & checksum = fhash)
4522# else
4523 & grid(ng) % latv)
4524# endif
4525 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4526 exit_flag=2
4527 ioerror=status
4528 EXIT
4529 ELSE
4530 IF (master) THEN
4531 WRITE (stdout,30) 'latitude of V-points: lat_v', &
4532 & ng, trim(ncname), fmin, fmax
4533# ifdef CHECKSUM
4534 WRITE (stdout,60) fhash
4535# endif
4536 END IF
4537 END IF
4538# ifdef NESTING
4539 CALL fill_contact(ng, model, tile, &
4540 & cr, vcontact(cr)%Npoints, vcontact, &
4541 & v2dvar, var_name(i), spval_check, &
4542 & lbi, ubi, lbj, ubj, &
4543 & contact_metric(cr) % Yv, &
4544 & grid(ng) % latv)
4545 IF (founderror(exit_flag, noerror, &
4546 & __line__, myfile)) RETURN
4547# endif
4548# ifdef DISTRIBUTE
4549 CALL mp_exchange2d (ng, tile, model, 1, &
4550 & lbi, ubi, lbj, ubj, &
4551 & nghostpoints, &
4552 & .false., .false., &
4553 & grid(ng) % latv)
4554# endif
4555 END IF
4556
4557
4558
4559 CASE ('angle')
4560 piovar%vd=var_desc(i)
4561 piovar%gtype=r2dvar
4562 IF (kind(grid(ng)%angler).eq.8) THEN
4563 piovar%dkind=pio_double
4564 iodesc => iodesc_dp_r2dvar(ng)
4565 ELSE
4566 piovar%dkind=pio_real
4567 iodesc => iodesc_sp_r2dvar(ng)
4568 END IF
4569
4570 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4571 & var_name(i), piovar, &
4572 & 0, iodesc, vsize, &
4573 & lbi, ubi, lbj, ubj, &
4574 & fscl, fmin, fmax, &
4575# ifdef MASKING
4576 & grid(ng) % rmask, &
4577# endif
4578# ifdef CHECKSUM
4579 & grid(ng) % angler, &
4580 & checksum = fhash)
4581# else
4582 & grid(ng) % angler)
4583# endif
4584 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4585 exit_flag=2
4586 ioerror=status
4587 EXIT
4588 ELSE
4589 IF (master) THEN
4590 WRITE (stdout,30) 'angle between XI-axis and EAST: '// &
4591 & 'angler', &
4592 & ng, trim(ncname), fmin, fmax
4593# ifdef CHECKSUM
4594 WRITE (stdout,60) fhash
4595# endif
4596 END IF
4597 END IF
4598# ifdef NESTING
4599 CALL fill_contact(ng, model, tile, &
4600 & cr, rcontact(cr)%Npoints, rcontact, &
4601 & r2dvar, 'angler', spval_check, &
4602 & lbi, ubi, lbj, ubj, &
4603 & contact_metric(cr) % angler, &
4604 & grid(ng) % angler)
4605 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4606# endif
4607 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4608 CALL exchange_r2d_tile (ng, tile, &
4609 & lbi, ubi, lbj, ubj, &
4610 & grid(ng) % angler)
4611 END IF
4612# ifdef DISTRIBUTE
4613 CALL mp_exchange2d (ng, tile, model, 1, &
4614 & lbi, ubi, lbj, ubj, &
4615 & nghostpoints, &
4616 & ewperiodic(ng), nsperiodic(ng), &
4617 & grid(ng) % angler)
4618# endif
4619# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
4620 defined opt_observations || defined sensitivity_4dvar || \
4621 defined so_semi
4622# ifndef OBS_SPACE
4623
4624
4625
4626 CASE ('scope_rho')
4627 piovar%vd=var_desc(i)
4628 piovar%gtype=r2dvar
4629 IF (kind(grid(ng)%Rscope).eq.8) THEN
4630 piovar%dkind=pio_double
4631 iodesc => iodesc_dp_r2dvar(ng)
4632 ELSE
4633 piovar%dkind=pio_real
4634 iodesc => iodesc_sp_r2dvar(ng)
4635 END IF
4636
4637 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4638 & var_name(i), piovar, &
4639 & 0, iodesc, vsize, &
4640 & lbi, ubi, lbj, ubj, &
4641 & fscl, fmin, fmax, &
4642# ifdef MASKING
4643 & grid(ng) % rmask, &
4644# endif
4645# ifdef CHECKSUM
4646 & grid(ng) % Rscope, &
4647 & checksum = fhash)
4648# else
4649 & grid(ng) % Rscope)
4650# endif
4651 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4652 exit_flag=2
4653 ioerror=status
4654 EXIT
4655 ELSE
4656 IF (master) THEN
4657 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
4658 & 'scope on RHO-points: scope_rho', &
4659 & ng, trim(ncname), fmin, fmax
4660# ifdef CHECKSUM
4661 WRITE (stdout,60) fhash
4662# endif
4663 END IF
4664 END IF
4665 gotscope(1)=.true.
4666 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4667 CALL exchange_r2d_tile (ng, tile, &
4668 & lbi, ubi, lbj, ubj, &
4669 & grid(ng) % Rscope)
4670 END IF
4671# ifdef DISTRIBUTE
4672 CALL mp_exchange2d (ng, tile, model, 1, &
4673 & lbi, ubi, lbj, ubj, &
4674 & nghostpoints, &
4675 & ewperiodic(ng), nsperiodic(ng), &
4676 & grid(ng) % Rscope)
4677# endif
4678
4679
4680
4681 CASE ('scope_u')
4682 piovar%vd=var_desc(i)
4683 piovar%gtype=u2dvar
4684 IF (kind(grid(ng)%Uscope).eq.8) THEN
4685 piovar%dkind=pio_double
4686 iodesc => iodesc_dp_u2dvar(ng)
4687 ELSE
4688 piovar%dkind=pio_real
4689 iodesc => iodesc_sp_u2dvar(ng)
4690 END IF
4691
4692 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4693 & var_name(i), piovar, &
4694 & 0, iodesc, vsize, &
4695 & lbi, ubi, lbj, ubj, &
4696 & fscl, fmin, fmax, &
4697# ifdef MASKING
4698 & grid(ng) % umask, &
4699# endif
4700# ifdef CHECKSUM
4701 & grid(ng) % Uscope, &
4702 & checksum = fhash)
4703# else
4704 & grid(ng) % Uscope)
4705# endif
4706 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4707 exit_flag=2
4708 ioerror=status
4709 EXIT
4710 ELSE
4711 IF (master) THEN
4712 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
4713 & 'scope on U-points: scope_u', &
4714 & ng, trim(ncname), fmin, fmax
4715# ifdef CHECKSUM
4716 WRITE (stdout,60) fhash
4717# endif
4718 END IF
4719 END IF
4720 gotscope(2)=.true.
4721 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4722 CALL exchange_u2d_tile (ng, tile, &
4723 & lbi, ubi, lbj, ubj, &
4724 & grid(ng) % Uscope)
4725 END IF
4726# ifdef DISTRIBUTE
4727 CALL mp_exchange2d (ng, tile, model, 1, &
4728 & lbi, ubi, lbj, ubj, &
4729 & nghostpoints, &
4730 & ewperiodic(ng), nsperiodic(ng), &
4731 & grid(ng) % Uscope)
4732# endif
4733
4734
4735
4736 CASE ('scope_v')
4737 piovar%vd=var_desc(i)
4738 piovar%gtype=v2dvar
4739 IF (kind(grid(ng)%Vscope).eq.8) THEN
4740 piovar%dkind=pio_double
4741 iodesc => iodesc_dp_v2dvar(ng)
4742 ELSE
4743 piovar%dkind=pio_real
4744 iodesc => iodesc_sp_v2dvar(ng)
4745 END IF
4746
4747 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4748 & var_name(i), piovar, &
4749 & 0, iodesc, vsize, &
4750 & lbi, ubi, lbj, ubj, &
4751 & fscl, fmin, fmax, &
4752# ifdef MASKING
4753 & grid(ng) % vmask, &
4754# endif
4755# ifdef CHECKSUM
4756 & grid(ng) % Vscope, &
4757 & checksum = fhash)
4758# else
4759 & grid(ng) % Vscope)
4760# endif
4761 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4762 exit_flag=2
4763 ioerror=status
4764 EXIT
4765 ELSE
4766 IF (master) THEN
4767 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
4768 & 'scope on V-points: scope_v', &
4769 & ng, trim(ncname), fmin, fmax
4770# ifdef CHECKSUM
4771 WRITE (stdout,60) fhash
4772# endif
4773 END IF
4774 END IF
4775 gotscope(3)=.true.
4776 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4777 CALL exchange_v2d_tile (ng, tile, &
4778 & lbi, ubi, lbj, ubj, &
4779 & grid(ng) % Vscope)
4780 END IF
4781# ifdef DISTRIBUTE
4782 CALL mp_exchange2d (ng, tile, model, 1, &
4783 & lbi, ubi, lbj, ubj, &
4784 & nghostpoints, &
4785 & ewperiodic(ng), nsperiodic(ng), &
4786 & grid(ng) % Vscope)
4787# endif
4788# endif
4789# endif
4790 END SELECT
4791 END DO
4792 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
4793 IF (master) WRITE (stdout,40) trim(var_name(i)), trim(ncname)
4794 RETURN
4795 END IF
4796
4797# if defined UV_DRAG_GRID && !defined ANA_DRAG
4798# ifdef UV_LOGDRAG
4799
4800
4801
4802 IF (kind(grid(ng)%ZoBot).eq.8) THEN
4803 piovar_zobl%dkind=pio_double
4804 iodesc => iodesc_dp_r2dvar(ng)
4805 ELSE
4806 piovar_zobl%dkind=pio_real
4807 iodesc => iodesc_sp_r2dvar(ng)
4808 END IF
4809
4810 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4811 & vname(1,idzobl), piovar_zobl, &
4812 & 0, iodesc, vsize, &
4813 & lbi, ubi, lbj, ubj, &
4814 & fscl, fmin, fmax, &
4815# ifdef MASKING
4816 & grid(ng) % rmask, &
4817# endif
4818# ifdef CHECKSUM
4819 & grid(ng) % ZoBot, &
4820 & checksum = fhash)
4821# else
4822 & grid(ng) % ZoBot)
4823# endif
4824 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4825 IF (master) WRITE (stdout,40) trim(vname(1,idzobl)), &
4826 & trim(ncname)
4827 exit_flag=2
4828 ioerror=status
4829 RETURN
4830 ELSE
4831 IF (master) THEN
4832 WRITE (stdout,30) 'time invariant, bottom roughness '// &
4833 & 'length scale: ZoBot', &
4834 & ng, trim(ncname), fmin, fmax
4835# ifdef CHECKSUM
4836 WRITE (stdout,60) fhash
4837# endif
4838 END IF
4839 END IF
4840 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4841 CALL exchange_r2d_tile (ng, tile, &
4842 & lbi, ubi, lbj, ubj, &
4843 & grid(ng) % ZoBot)
4844 END IF
4845# ifdef DISTRIBUTE
4846 CALL mp_exchange2d (ng, tile, model, 1, &
4847 & lbi, ubi, lbj, ubj, &
4848 & nghostpoints, &
4849 & ewperiodic(ng), nsperiodic(ng), &
4850 & grid(ng) % ZoBot)
4851# endif
4852# endif
4853# ifdef UV_LDRAG
4854
4855
4856
4857 IF (kind(grid(ng)%rdrag).eq.8) THEN
4858 piovar_dragl%dkind=pio_double
4859 iodesc => iodesc_dp_r2dvar(ng)
4860 ELSE
4861 piovar_dragl%dkind=pio_real
4862 iodesc => iodesc_sp_r2dvar(ng)
4863 END IF
4864
4865 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4866 & vname(1,idragl), piovar_dragl, &
4867 & 0, iodesc, vsize, &
4868 & lbi, ubi, lbj, ubj, &
4869 & fscl, fmin, fmax, &
4870# ifdef MASKING
4871 & grid(ng) % rmask, &
4872# endif
4873# ifdef CHECKSUM
4874 & grid(ng) % rdrag, &
4875 & checksum = fhash)
4876# else
4877 & grid(ng) % rdrag)
4878# endif
4879 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4880 IF (master) WRITE (stdout,40) trim(vname(1,idragl)), &
4881 & trim(ncname)
4882 exit_flag=2
4883 ioerror=status
4884 RETURN
4885 ELSE
4886 IF (master) THEN
4887 WRITE (stdout,30) 'linear bottom drag coefficient: rdrag', &
4888 & ng, trim(ncname), fmin, fmax
4889# ifdef CHECKSUM
4890 WRITE (stdout,60) fhash
4891# endif
4892 END IF
4893 END IF
4894 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4895 CALL exchange_r2d_tile (ng, tile, &
4896 & lbi, ubi, lbj, ubj, &
4897 & grid(ng) % rdrag)
4898 END IF
4899# ifdef DISTRIBUTE
4900 CALL mp_exchange2d (ng, tile, model, 1, &
4901 & lbi, ubi, lbj, ubj, &
4902 & nghostpoints, &
4903 & ewperiodic(ng), nsperiodic(ng), &
4904 & grid(ng) % rdrag)
4905# endif
4906# endif
4907# ifdef UV_QDRAG
4908
4909
4910
4911 IF (kind(grid(ng)%rdrag2).eq.8) THEN
4912 piovar_dragq%dkind=pio_double
4913 iodesc => iodesc_dp_r2dvar(ng)
4914 ELSE
4915 piovar_dragq%dkind=pio_real
4916 iodesc => iodesc_sp_r2dvar(ng)
4917 END IF
4918
4919 status=nf_fread2d(ng, model, ncname, grd(ng)%pioFile, &
4920 & vname(1,idragq), piovar_dragq, &
4921 & 0, iodesc, vsize, &
4922 & lbi, ubi, lbj, ubj, &
4923 & fscl, fmin, fmax, &
4924# ifdef MASKING
4925 & grid(ng) % rmask, &
4926# endif
4927# ifdef CHECKSUM
4928 & grid(ng) % rdrag2, &
4929 & checksum = fhash)
4930# else
4931 & grid(ng) % rdrag2)
4932# endif
4933 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4934 IF (master) WRITE (stdout,40) trim(vname(1,idragq)), &
4935 & trim(ncname)
4936 exit_flag=2
4937 ioerror=status
4938 RETURN
4939 ELSE
4940 IF (master) THEN
4941 WRITE (stdout,30) 'quadratic bottom drag coefficient: rdrag2',&
4942 & ng, trim(ncname), fmin, fmax
4943# ifdef CHECKSUM
4944 WRITE (stdout,60) fhash
4945# endif
4946 END IF
4947 END IF
4948 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
4949 CALL exchange_r2d_tile (ng, tile, &
4950 & lbi, ubi, lbj, ubj, &
4951 & grid(ng) % rdrag2)
4952 END IF
4953# ifdef DISTRIBUTE
4954 CALL mp_exchange2d (ng, tile, model, 1, &
4955 & lbi, ubi, lbj, ubj, &
4956 & nghostpoints, &
4957 & ewperiodic(ng), nsperiodic(ng), &
4958 & grid(ng) % rdrag2)
4959# endif
4960# endif
4961# endif
4962
4963
4964
4965 CALL pio_netcdf_close (ng, model, grd(ng)%pioFile, ncname, .false.)
4966 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4967
4968# if defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
4969 defined opt_observations || defined sensitivity_4dvar || \
4970 defined so_semi
4971# ifndef OBS_SPACE
4972
4973
4974
4975
4976
4977
4978 ncname=ads(ng)%name
4979
4980
4981
4982 IF (ads(ng)%pioFile%fh.eq.-1) THEN
4983 CALL pio_netcdf_open (ng, model, ncname, 0, ads(ng)%pioFile)
4984 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
4985 WRITE (stdout,10) trim(ncname)
4986 RETURN
4987 END IF
4988 END IF
4989
4990
4991
4992 CALL pio_netcdf_check_dim (ng, model, ncname, &
4993 & piofile = ads(ng)%pioFile)
4994 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4995
4996
4997
4998 CALL pio_netcdf_inq_var (ng, model, ncname, &
4999 & piofile = ads(ng)%pioFile)
5000 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5001
5002
5003
5004 gotscope(4)=find_string(var_name,n_var,'scope_rho',vindex)
5005 gotscope(5)=find_string(var_name,n_var,'scope_u',vindex)
5006 gotscope(6)=find_string(var_name,n_var,'scope_v',vindex)
5007
5008 IF ((.not.gotscope(1)).and.(.not.gotscope(4))) THEN
5009 IF (master) WRITE (stdout,20) 'scope_rho', trim(ncname)
5010 exit_flag=2
5011 RETURN
5012 END IF
5013 IF ((.not.gotscope(2)).and.(.not.gotscope(5))) THEN
5014 IF (master) WRITE (stdout,20) 'scope_u', trim(ncname)
5015 exit_flag=2
5016 RETURN
5017 END IF
5018 IF ((.not.gotscope(3)).and.(.not.gotscope(6))) THEN
5019 IF (master) WRITE (stdout,20) 'scope_v', trim(ncname)
5020 exit_flag=2
5021 RETURN
5022 END IF
5023 IF (master) THEN
5024 IF (gotscope(4)) THEN
5025 WRITE (stdout,50) trim(ads(ng)%name)
5026 ELSE
5027 WRITE (stdout,50) trim(grd(ng)%name)
5028 END IF
5029 END IF
5030
5031
5032
5033 DO i=1,n_var
5034
5035 SELECT CASE (trim(adjustl(var_name(i))))
5036
5037
5038
5039 CASE ('scope_rho')
5040 piovar%vd=var_desc(i)
5041 piovar%gtype=r2dvar
5042 IF (kind(grid(ng)%Rscope).eq.8) THEN
5043 piovar%dkind=pio_double
5044 iodesc => iodesc_dp_r2dvar(ng)
5045 ELSE
5046 piovar%dkind=pio_real
5047 iodesc => iodesc_sp_r2dvar(ng)
5048 END IF
5049
5050 status=nf_fread2d(ng, model, ncname, ads(ng)%pioFile, &
5051 & var_name(i), piovar, &
5052 & 0, iodesc, vsize, &
5053 & lbi, ubi, lbj, ubj, &
5054 & fscl, fmin, fmax, &
5055# ifdef MASKING
5056 & grid(ng) % rmask, &
5057# endif
5058# ifdef CHECKSUM
5059 & grid(ng) % Rscope, &
5060 & checksum = fhash)
5061# else
5062 & grid(ng) % Rscope)
5063# endif
5064 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5065 exit_flag=2
5066 ioerror=status
5067 EXIT
5068 ELSE
5069 IF (master) THEN
5070 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
5071 & 'scope on RHO-points: scope_rho', &
5072 & ng, trim(ncname), fmin, fmax
5073# ifdef CHECKSUM
5074 WRITE (stdout,60) fhash
5075# endif
5076 END IF
5077 END IF
5078 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5079 CALL exchange_r2d_tile (ng, tile, &
5080 & lbi, ubi, lbj, ubj, &
5081 & grid(ng) % Rscope)
5082 END IF
5083# ifdef DISTRIBUTE
5084 CALL mp_exchange2d (ng, tile, model, 1, &
5085 & lbi, ubi, lbj, ubj, &
5086 & nghostpoints, &
5087 & ewperiodic(ng), nsperiodic(ng), &
5088 & grid(ng) % Rscope)
5089# endif
5090
5091
5092
5093 CASE ('scope_u')
5094 piovar%vd=var_desc(i)
5095 piovar%gtype=u2dvar
5096 IF (kind(grid(ng)%Uscope).eq.8) THEN
5097 piovar%dkind=pio_double
5098 iodesc => iodesc_dp_u2dvar(ng)
5099 ELSE
5100 piovar%dkind=pio_real
5101 iodesc => iodesc_sp_u2dvar(ng)
5102 END IF
5103
5104 status=nf_fread2d(ng, model, ncname, ads(ng)%pioFile, &
5105 & var_name(i), piovar, &
5106 & 0, iodesc, vsize, &
5107 & lbi, ubi, lbj, ubj, &
5108 & fscl, fmin, fmax, &
5109# ifdef MASKING
5110 & grid(ng) % umask, &
5111# endif
5112# ifdef CHECKSUM
5113 & grid(ng) % Uscope, &
5114 & checksum = fhash)
5115# else
5116 & grid(ng) % Uscope)
5117# endif
5118 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5119 exit_flag=2
5120 ioerror=status
5121 EXIT
5122 ELSE
5123 IF (master) THEN
5124 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
5125 & 'scope on U-points: scope_u', &
5126 & ng, trim(ncname), fmin, fmax
5127# ifdef CHECKSUM
5128 WRITE (stdout,60) fhash
5129# endif
5130 END IF
5131 END IF
5132 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5133 CALL exchange_u2d_tile (ng, tile, &
5134 & lbi, ubi, lbj, ubj, &
5135 & grid(ng) % Uscope)
5136 END IF
5137# ifdef DISTRIBUTE
5138 CALL mp_exchange2d (ng, tile, model, 1, &
5139 & lbi, ubi, lbj, ubj, &
5140 & nghostpoints, &
5141 & ewperiodic(ng), nsperiodic(ng), &
5142 & grid(ng) % Uscope)
5143# endif
5144
5145
5146
5147 CASE ('scope_v')
5148 piovar%vd=var_desc(i)
5149 piovar%gtype=v2dvar
5150 IF (kind(grid(ng)%Vscope).eq.8) THEN
5151 piovar%dkind=pio_double
5152 iodesc => iodesc_dp_v2dvar(ng)
5153 ELSE
5154 piovar%dkind=pio_real
5155 iodesc => iodesc_sp_v2dvar(ng)
5156 END IF
5157
5158 status=nf_fread2d(ng, model, ncname, ads(ng)%pioFile, &
5159 & var_name(i), piovar, &
5160 & 0, iodesc, vsize, &
5161 & lbi, ubi, lbj, ubj, &
5162 & fscl, fmin, fmax, &
5163# ifdef MASKING
5164 & grid(ng) % vmask, &
5165# endif
5166# ifdef CHECKSUM
5167 & grid(ng) % Vscope, &
5168 & checksum = fhash)
5169# else
5170 & grid(ng) % Vscope)
5171# endif
5172 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5173 exit_flag=2
5174 ioerror=status
5175 EXIT
5176 ELSE
5177 IF (master) THEN
5178 WRITE (stdout,30) 'adjoint sensitivity spatial '// &
5179 & 'scope on V-points: scope_v', &
5180 & ng, trim(ncname), fmin, fmax
5181# ifdef CHECKSUM
5182 WRITE (stdout,60) fhash
5183# endif
5184 END IF
5185 END IF
5186 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
5187 CALL exchange_v2d_tile (ng, tile, &
5188 & lbi, ubi, lbj, ubj, &
5189 & grid(ng) % Vscope)
5190 END IF
5191# ifdef DISTRIBUTE
5192 CALL mp_exchange2d (ng, tile, model, 1, &
5193 & lbi, ubi, lbj, ubj, &
5194 & nghostpoints, &
5195 & ewperiodic(ng), nsperiodic(ng), &
5196 & grid(ng) % Vscope)
5197# endif
5198 END SELECT
5199 END DO
5200 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
5201 IF (master) WRITE (stdout,40) trim(var_name(i)), trim(ncname)
5202 RETURN
5203 END IF
5204# endif
5205# endif
5206
5207 10 FORMAT (/,' GET_GRID_PIO - unable to open grid NetCDF file: ',a)
5208 20 FORMAT (/,' GET_GRID_PIO - unable to find grid variable: ',a, &
5209 & /,16x,'in grid NetCDF file: ',a)
5210 30 FORMAT (2x,'GET_GRID_PIO - ',a,/,22x, &
5211 & '(Grid = ',i2.2,', File: ',a,')',/,22x, &
5212 & '(Min = ', 1p,e15.8,0p,' Max = ',1p,e15.8,0p,')')
5213 40 FORMAT (/,' GET_GRID_PIO - error while reading variable: ',a, &
5214 & /,12x,'in grid NetCDF file: ',a)
5215 50 FORMAT (/,2x,'GET_GRID_PIO - Reading adjoint sensitivity', &
5216 & ' scope arrays from file:',/22x,a,/)
5217# ifdef CHECKSUM
5218 60 FORMAT (22x,'(CheckSum = ',i0,')')
5219# endif
5220
5221 RETURN